home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 726-750 / 729 / bbbbs / bbbbs54.lzh / rexx / BBBBS.baud < prev    next >
Text File  |  1992-08-04  |  176KB  |  6,380 lines
  1. /*     $VER: 5.4 BBBBS.baud 4 Aug 1992 (4.8.92) 7:44PM
  2. copyright 1990-91-92 Richard Lee Stockton FREELY DISTRIBUTABLE
  3.  
  4.      BBBBS.baud. A full-featured BBS in ARexx for Baudbandit
  5. based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit!
  6.  
  7.  See Information/BBBBS.doc & rexx/bbsLOCAL.rexx for install info
  8. */
  9.  
  10. saypath='SYS:Utilities/Say'
  11.  
  12. copyright.=''
  13. copyright.1=STRIP(SUBSTR(SOURCELINE(1),3))
  14. copyright.2='
  15. from Gramma Software 17730-15th NE Suite 223 Seattle WA 98155'
  16. copyright.3='
  17. ARexx portions of this software copyright 1990-91-92 Richard Lee Stockton'
  18. copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'
  19.  
  20. /* If QuickSortPort not found then try to run setup.rexx */
  21.  
  22. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  23. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  24.  
  25. IF SHOW('P','BBBBS') THEN
  26.   DO
  27.     SAY 'BBBBS is already running!'
  28.     EXIT 0
  29.   END
  30. CALL OPENPORT('BBBBS')
  31. CALL SETCLIP('BBS_version',copyright.1)
  32. CALL SETCLIP('BBS_localfiles')
  33. CALL SETCLIP('BBS_localusers')
  34.  
  35. /* try to trap everything */
  36.  
  37. OPTIONS RESULTS
  38. OPTIONS FAILAT 999999
  39. NUMERIC DIGITS 14
  40. SIGNAL ON HALT
  41. SIGNAL ON SYNTAX
  42. SIGNAL ON FAILURE
  43. SIGNAL OFF BREAK_C
  44. SIGNAL OFF BREAK_E
  45.  
  46. PARSE VERSION . . cpu .
  47. cpu=RIGHT(cpu,2)/10
  48. IF cpu<1 THEN cpu=1
  49. Status Vers
  50. BB_VERS=RESULT
  51. bm=50
  52. IF RIGHT(BB_VERS,4)>1.59 THEN bm=25
  53.  
  54. dcd
  55. IF RC=0 THEN Send 'ATH1\r'
  56.  
  57. bbsprefs.=0  /* start with all prefs OFF */
  58. alpha.=''
  59. logonflag=1
  60. emailonline=-1
  61. CALL zerovars()
  62.  
  63.  
  64. /* TEXT - User data structure by line */
  65.  
  66. text.=''
  67. text.1='   Full Name'
  68. text.2='      Street'
  69. text.3='City, ST Zip'
  70. text.4=' Voice Phone'
  71. text.5='    Password'
  72. text.6='    Protocol'
  73. text.7='LinesPerPage'
  74. text.8=' Preferences'
  75. text.9='    Computer'
  76. text.10='   Interests'
  77. text.11='Session Time'
  78. text.12='FirstSession'
  79. text.13='Last Session'
  80. text.14='      UpLoad'
  81. text.15='    Download'
  82. text.16='   Last File'
  83. text.17='Ratio  Email'
  84. text.18='    Winnings'
  85. text.19='       Usage'
  86. text.20='       Level'
  87. text.21='Exclude DIRS'
  88. text.22='   Msgs Read'
  89. text.23='   Msgs Writ'
  90.  
  91.  
  92. name=''
  93. CR='0D'x
  94. LF='0A'x
  95.  
  96. SAY CR
  97. SAY CENTER(copyright.1,75)||CR
  98.  
  99. CALL PRAGMA('W','N')
  100. CALL config()
  101.  
  102. IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
  103.   ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'
  104.  
  105. SAY CENTER(copyright.2,75)||CR
  106.  
  107. /* open printer? */
  108. IF bbsprefs.3 THEN
  109.   DO
  110.     IF ~OPEN(p,'PRT:','W') THEN
  111.       DO
  112.         CALL WRITELN('log','failed to open printer.')
  113.         bbsprefs.3=0
  114.       END
  115.   END
  116.  
  117. /* CALL PRAGMA('W','W')   <-- UN-COMMENT THIS LINE TO ENABLE REQUESTERS */
  118. CALL colors(1)
  119. Capture OFF
  120. Timeout 120
  121. SAY CENTER(copyright.3,75)||CR
  122.  
  123. excuses.=''
  124. courtesy=''
  125. courtesyflag=0
  126. SAY CENTER(copyright.4,75)||CR
  127. SAY CR
  128. SAY CR
  129. SAY '                      Setting up, please wait...'CR
  130. SAY CR
  131.  
  132. msg.=''
  133. IF readopen(bbspath'Lists/Conferences') THEN
  134.   DO
  135.     DO i=1
  136.       line=READLN(f)
  137.       IF line='END' THEN BREAK
  138.       IF EOF(f) THEN BREAK
  139.       num=WORD(line,1)
  140.       IF DATATYPE(num,'N') THEN msg.num=WORD(line,2)
  141.     END
  142.     CALL CLOSE(f)
  143.   END
  144.  
  145. dirs.=''
  146. IF readopen(bbspath'Lists/Libraries') THEN
  147.   DO
  148.     DO i=1
  149.       line=READLN(f)
  150.       IF line='END' | EOF(f) THEN LEAVE i
  151.       num=WORD(line,1)
  152.       IF DATATYPE(num,'N') THEN dirs.num=STRIP(WORD(line,2))
  153.     END
  154.     CALL CLOSE(f)
  155.   END
  156. CALL loaduserlist()
  157. SAY CR
  158. SAY '          The larger the BBS gets, the longer it takes to setup...'CR
  159. CALL loadfiles()
  160. dcd
  161. IF RC~=0 THEN
  162.   DO
  163.     SAY CR
  164.     SAY '      If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR
  165.   END
  166. SAY CR
  167. CALL set_grand()
  168. CALL loadalpha()
  169.  
  170. dcd
  171. IF RC=0 THEN
  172.   DO
  173.     logonflag=0
  174.     SIGNAL DONE
  175.   END
  176.  
  177. LOGON:
  178. CALL checkdcd()
  179. bps=0
  180. SetMark 'CONNECT'
  181. IF RC=1 THEN
  182.   DO
  183.     GetLine
  184.     connectline=RESULT
  185.     PARSE VAR connectline 'CONNECT'bps
  186.     CALL STRIP(bps)
  187.   END
  188. IF bps<300 | bps>38400 THEN
  189.   DO
  190.     SetMark 'CARRIER'
  191.     IF RC=1 THEN
  192.       DO
  193.         GetLine
  194.         connectline=RESULT
  195.         PARSE VAR connectline 'CARRIER'bps
  196.         CALL STRIP(bps)
  197.       END
  198.     ELSE bps='000 '
  199.   END
  200. DO i=4 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
  201. END
  202. bps=LEFT(bps,i-1)
  203. SIGNAL ON BREAK_C
  204. SIGNAL OFF BREAK_E
  205. REMOTE ON
  206. TimeOut 120
  207. IF bps<300 THEN bps=getbaudrate()
  208. IF bps>14400 THEN bps=getinput(1 0 'Please enter your modem to modem baudrate > ')
  209. IF bps<300 THEN SIGNAL DONE
  210. bps=bps%1
  211. IF logonflag=0 THEN
  212.   DO
  213.     logonflag=1
  214.     DO i=1 TO 7
  215.       SAY '  'CR
  216.     END
  217.     DO i=1 TO 4
  218.       SAY CENTER(copyright.i,75)||CR
  219.     END
  220.     CALL DELAY(150)
  221.     CALL colors(1)
  222.     SAY CR
  223.     SAY CR
  224.     SAY CR
  225.   END
  226.  
  227. IF alpha.0='' THEN CALL loadalpha()
  228.  
  229. CALL TIME('R')
  230.  
  231. /** Identify (title) message */
  232. IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  233.   DO
  234.     arg=bbspath'BBS_TEXT/HELLO'
  235.     CALL readlines(arg 1)
  236.     CALL seelines(0)
  237.   END
  238. SAY CR
  239.  
  240. SAY 'Running on' BB_VERS 'at' bps 'baud.'CR
  241. Stat 'Z'
  242. CALL checkdcd()
  243.  
  244. /* Ask for name */
  245. name=''
  246. courtesy=''
  247. Queue CR
  248. DO count=1 TO 3
  249.   name=getinput(1 0 'Please enter name: ')
  250.   name=cleanstring(1':'name)
  251.   IF name='NEW' THEN LEAVE count
  252.   IF name~='' THEN
  253.     DO
  254.       IF FIND(userlist,name)>0 THEN LEAVE count
  255.       IF FIND(exclusion,name)>0 THEN
  256.         DO
  257.           SAY 'Sorry, that is a reserved name.'CR
  258.           name=''
  259.           ITERATE count
  260.         END
  261.       CALL loadcourtesy()
  262.       IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
  263.         DO
  264.           SAY CR
  265.           SAY 'Welcome' name'!'CR
  266.           SAY 'You will be automatically validated after you enter your user info.'CR
  267.           SAY CR
  268.           LEAVE count
  269.         END
  270.     END
  271.   IF count<3 THEN SAY 'New Users please enter NEW to apply for validation.'CR
  272. END
  273. IF count>3 THEN SIGNAL DONE
  274. CALL TIME('R')
  275. logontime=TIME('C')
  276. line=left(name,16,' ') 'logged in  at' time('C') date('W') date() 'at' bps 'baud'
  277. CALL send2log(line)
  278. CALL checkUser()
  279. prevcaller=''
  280. prevcaller=GETCLIP('BBS_lastcaller')
  281. IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller)
  282. city=docity(data.3)
  283. CALL SETCLIP('BBS_lastcaller',name city'  'TIME('C') DATE())
  284. CALL SETCLIP('BBS_level',level)
  285. CALL postuser(0)
  286. Beep (bm*10)
  287. CALL DELAY(7)
  288. Beep (bm*7)
  289. Timeout maxidle         /* max idle time at prompts */
  290.  
  291.  
  292. /*
  293. Opening Display after logon. Seen by all Users ONCE A DAY. It first
  294. looks for a unique yearly data (ie, WELCOME.0704), then daily data
  295. (ie, WELCOME.Fri), and finally a simple, everyday 'WELCOME' datafile
  296. */
  297.  
  298. IF DATE('I')>lastondate THEN
  299.   DO
  300.     arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
  301.     IF ~EXISTS(arg) THEN
  302.       DO
  303.         arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
  304.         IF ~EXISTS(arg) THEN arg=bbspath'BBS_TEXT/WELCOME'
  305.       END
  306.     IF EXISTS(arg) THEN
  307.       DO
  308.         SAY CR
  309.         CALL showtext(arg)
  310.         nonstop=0
  311.       END
  312.  
  313. /*
  314. Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
  315. Deletes any that are previous to "today"
  316. */
  317.  
  318.     untils.=''
  319.     IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
  320.       DO
  321.         CALL QSORT(1,untils.0,untils)
  322.         DO ui=1 TO untils.0
  323.           IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
  324.           ELSE
  325.             DO
  326.               SAY CR
  327.               CALL showtext(untils.ui)
  328.               nonstop=0
  329.             END
  330.         END
  331.       END
  332.     DROP untils.
  333.  
  334.     IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
  335.       DO
  336.         SAY CR
  337.         SAY 'Please help us out by entering the following information.'CR
  338.         CALL getbirth()
  339.         SAY '   Thank you!'CR
  340.       END
  341.   END
  342.  
  343. IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
  344.   DO
  345.     arg=bbspath'BBS_TEXT/BIRTHDAY'
  346.     IF EXISTS(arg) THEN 
  347.       DO
  348.         SAY CR
  349.         CALL showtext(arg)
  350.         nonstop=0
  351.       END
  352.     SAY CR
  353.     SAY '***  Happy Birthday,' pen3||data.1||def', and many more!  ***'CR
  354.     SAY CR
  355.   END
  356. SAY CR
  357.  
  358. /** Save old data directory */
  359. Status DataDir
  360. startdir=result
  361.  
  362. IF bbsprefs.1 & ~terseflag THEN
  363.   DO
  364.     IF doGrin()>3 THEN CALL waiting()
  365.     IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
  366.     IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
  367.     IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
  368.       DO
  369.         IF EXISTS('RAM:TODAY') THEN
  370.           DO
  371.             finfo=STATEF('RAM:TODAY')
  372.             IF WORD(finfo,5)~=DATE('I') THEN
  373.               ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
  374.           END
  375.         ELSE ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
  376.         IF EXISTS('RAM:TODAY') THEN
  377.           DO
  378.             CALL readlines('RAM:TODAY' 1)
  379.             CALL seelines(0)
  380.           END
  381.       END
  382.     SAY CR
  383.   END
  384. CALL sortlibraries()
  385.  
  386. /* Get current protocol */
  387. Status Trans
  388. protocol=RESULT
  389.  
  390. CALL readmail(0)
  391. lastbrowse=WORD(data.16,1)
  392. IF ~DATATYPE(lastbrowse,'N') THEN lastbrowse=0
  393. IF ~terseflag THEN
  394.   DO
  395.     IF level>sysoplevel THEN
  396.       DO
  397.         lstmail=WORD(data.17,3)
  398.         IF ~DATATYPE(lstmail,'N') THEN lstmail=0
  399.         IF countcheck(bbspath'Numbers/LastMail' 0)>lstmail THEN
  400.           IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
  401.         IF level<99 THEN
  402.           DO
  403.             SAY CR
  404.             CALL showtext(bbspath'Email/'sysop'/NEW_FILES')
  405.           END
  406.         SAY CR
  407.         CALL showtext(bbspath'Lists/NEW_USERS')
  408.       END
  409.     CALL logonstats()
  410.     CALL newinfo()
  411.   END
  412. CALL showmarked()
  413. CALL setdir(libpath||dirs.1)
  414. logonflag=0
  415.  
  416.  
  417. /***** MAIN *****/
  418.  
  419. IF menu~='ALL' THEN menu='MAIN'
  420.  
  421. RESTART:
  422. IF name='' | data.20='' | logonflag THEN SIGNAL LOGON  /* login was interrupted */
  423. SIGNAL ON BREAK_C
  424. SIGNAL ON BREAK_E
  425.  
  426. waitchar=''
  427. string=''
  428. IF level<1 THEN menu='NEW'
  429. DO WHILE(opt~='G')
  430.   go=0
  431.   DO WHILE(~go)
  432.     IF waitchar='' | waitchar='?' THEN
  433.       DO
  434.         commands='cghiqsvwxyz!#,'
  435.         IF level>0  THEN commands='abcdefghijlmnoprstuvwxyz!$#&+,.'
  436.         IF level>sysoplevel THEN commands=commands'k%^()=;'
  437.         IF level=99 THEN commands=commands'@~'
  438.         commands=commands'?'
  439.         IF menuflag | waitchar='?' | string='?' THEN
  440.           DO
  441.             opt='MENU'
  442.             arg=''
  443.             CALL postuser(1)
  444.             CALL menus()
  445.           END
  446.         ELSE SAY pen3'COMMANDS:'def commands||CR
  447.       END
  448.     CALL showtime()
  449.     line=''
  450.     line=line||bak2' 'TIME('C')' 'def
  451.     IF menu='ALL' | menu='FILE' THEN
  452.       line=line pen3'FILE_LIBRARY:'plaindir||def
  453.     ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
  454.     ELSE line=line pen3'MAIN:'def
  455.     IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
  456.     PARSE VAR waitchar string' 'arg
  457.     CALL checkdcd()
  458.     nonstop=0
  459.     string=UPPER(STRIP(string))
  460.     IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2
  461.     waitchar=''
  462.     warnings=0
  463.     IF DATATYPE(string,'N') THEN
  464.       DO
  465.         dirnum=string
  466.         CALL chdir2()
  467.         CALL since()
  468.       END
  469.     IF LEFT(string,3)='+++' THEN string=''
  470.     opt=left(string,1)
  471.     IF opt='G' THEN
  472.       DO
  473.         IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?'
  474.       END
  475.     go=1    /* check for access */
  476.     IF POS(opt,UPPER(commands))=0 THEN go=0
  477.   END
  478.   CALL postuser(1)
  479.   OPTIONS PROMPT 'Filename: '
  480.   SELECT
  481.     WHEN(opt='A') THEN CALL showalpha()
  482.     WHEN(opt='B') THEN CALL browse()
  483.     WHEN(opt='C') THEN CALL editor('MAIL' sysop)
  484.     WHEN(opt='D') THEN CALL dload()
  485.     WHEN(opt='E') THEN CALL readmail(1)
  486.     WHEN(opt='F') THEN IF menu~='ALL' THEN menu='FILE'
  487.     WHEN(opt='H') THEN CALL help('MAIN')
  488.     WHEN(opt='I') THEN CALL information()
  489.     WHEN(opt='J') THEN CALL jump2rexx()
  490.     WHEN(opt='K') THEN CALL killuser()
  491.     WHEN(opt='L') THEN CALL list()
  492.     WHEN(opt='M') THEN IF menu~='ALL' THEN menu='MSG'
  493.     WHEN(opt='N') THEN CALL newfiles()
  494.     WHEN(opt='O') THEN CALL otheruser()
  495.     WHEN(opt='P') THEN CALL editor('MSG')
  496.     WHEN(opt='R') THEN CALL readmessages()
  497.     WHEN(opt='S') THEN CALL bbsSEARCH()
  498.     WHEN(opt='T') THEN CALL chpro()
  499.     WHEN(opt='U') THEN CALL uload(1)
  500.     WHEN(opt='V') THEN CALL showtext(bbspath'Usage/USER.LOG')
  501.     WHEN(opt='W') THEN CALL showuserlist()
  502.     WHEN(opt='X') THEN CALL switchmenuflag()
  503.     WHEN(opt='Y') THEN CALL edituser()
  504.     WHEN(opt='Z') THEN CALL counts()
  505.     WHEN(opt='~') THEN CALL sysED(1)
  506.     WHEN(opt='!') THEN CALL yell()
  507.     WHEN(opt='@') THEN CALL shell()
  508.     WHEN(opt='#') THEN CALL switchcolors()
  509.     WHEN(opt='$') THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
  510.     WHEN(opt='%') THEN CALL editnote()
  511.     WHEN(opt='^') THEN CALL readlogs()
  512.     WHEN(opt='&') THEN CALL profiles(1)
  513.     WHEN(opt='+') THEN CALL ext_dload()
  514.     WHEN(opt='(') THEN CALL filereport()
  515.     WHEN(opt=')') THEN CALL mailreport()
  516.     WHEN(opt='=') THEN CALL levelreport()
  517.     WHEN(opt=';') THEN CALL changename()
  518.     WHEN(opt=',') THEN DO;CALL hourly();CALL waiting();END
  519.     WHEN(opt='.') THEN IF menu~='ALL' THEN menu='MAIN'
  520.     WHEN(opt='?') & menuflag THEN CALL help('MAIN')
  521.     OTHERWISE NOP
  522.   END
  523. END
  524. SIGNAL LOGOUT
  525. EXIT       /* an extra margin of safety */
  526.  
  527.  
  528. /* FUNCTIONS */
  529.  
  530. cleanstring:
  531. PARSE ARG nflag':'cstr
  532. bot=TRIM(XRANGE(,' '))
  533. bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
  534. top=XRANGE('7F'x)
  535. IF nflag=1 THEN
  536.   DO
  537.     bot=bot||XRANGE('!','@')'[\]`~{:}'
  538.     cstr=TRANSLATE(UPPER(cstr),' ','_')
  539.   END
  540. cstr=COMPRESS(cstr,bot||top)
  541. IF nflag~=2 THEN cstr=STRIP(cstr)
  542. IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
  543. RETURN cstr
  544.  
  545.  
  546. showtext:
  547. PARSE ARG arg .
  548. IF EXISTS(arg) THEN
  549.   DO
  550.     CALL readlines(arg 1)
  551.     CALL seelines(1)
  552.     nonstop=0
  553.     CALL waiting()
  554.   END
  555. RETURN
  556.  
  557.  
  558. doGrin:
  559. IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
  560. CALL setdir(bbspath'rexxDoors')
  561. temp=Grin_du_Jour.rexx()
  562. SAY CR
  563. RETURN temp
  564.  
  565.  
  566. send2log:
  567. PARSE ARG sendline
  568. logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
  569. IF ~OPEN('log',logfile,'A') THEN
  570.   DO
  571.     IF ~OPEN('log',logfile,'W') THEN
  572.       DO
  573.         SAY 'failed to open log file'
  574.         SIGNAL DONE
  575.      END
  576.   END
  577. CALL WRITELN('log',sendline)
  578. CALL CLOSE('log')
  579. IF bbsprefs.3=1 THEN CALL WRITELN(p,sendline)
  580. RETURN
  581.  
  582.  
  583. send2last:
  584. PARSE ARG sendline
  585. IF name=sysop THEN RETURN   /* delete to have sysop in USER.LOG */
  586. lynes.=''
  587. lynes.0=2
  588. lynes.1='        -'pen3 bbsname def'user log for the last 99 calls -'
  589. lynes.2=sendline
  590. logfile=bbspath'USAGE/USER.LOG'  /* simple usage log */
  591. IF EXISTS(logfile) THEN
  592.   DO
  593.     x=OPEN(lu,logfile,'R')
  594.     IF x=0 THEN RETURN
  595.     CALL READLN(lu)
  596.     DO i=3 TO 99
  597.       sendline=READLN(lu)
  598.       IF EOF(lu) THEN LEAVE i
  599.       lynes.i=sendline
  600.     END
  601.     CALL CLOSE(lu)
  602.     IF i>99 THEN lynes.0=99
  603.     ELSE lynes.0=i-1
  604.   END
  605. x=OPEN(lu,logfile,'W')
  606. IF x=0 THEN RETURN
  607. DO i=1 TO lynes.0
  608.   CALL WRITELN(lu,lynes.i)
  609. END
  610. CALL CLOSE(lu)
  611. RETURN
  612.  
  613.  
  614. killuser:
  615. IF level<=sysoplevel THEN RETURN
  616. killcount=0
  617. DO loop=1
  618.   IF arg='' THEN
  619.     DO
  620.       OPTIONS PROMPT 'RETURN=QUIT  Username to Kill: '
  621.       PULL arg
  622.     END
  623.   IF STRIP(arg)='' THEN LEAVE loop
  624.   arg=UPPER(arg)
  625.   arg=SPACE(STRIP(arg),1,'_')
  626.   IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN
  627.     DO
  628.       arg=''
  629.       ITERATE loop
  630.     END
  631.   SAY 'Working...'lineup||CR
  632.   IF readlines(bbspath'Users/'arg 1) THEN
  633.     DO
  634.       SAY 'User' arg 'not found.'CR
  635.       arg=''
  636.       ITERATE loop
  637.     END
  638.   IF level<=lynes.20 THEN
  639.     DO
  640.       SAY '*** Tsk! Tsk!  Your level is not greater than' arg'.'CR
  641.       CALL send2log('Tried to kill:' arg)
  642.       arg=''
  643.       ITERATE loop
  644.     END
  645.   CALL DELETE(bbspath'Users/'arg)
  646.   IF EXISTS(bbspath'Email/'arg) THEN
  647.     DO
  648.       temp=WORDS(SHOWDIR(bbspath'Email/'arg))
  649.       emailonline=emailonline-temp
  650.       ADDRESS COMMAND 'C:DELETE >*' bbspath'Email/'arg 'ALL'
  651.     END
  652.   IF EXISTS(bbspath'EmailFiles/'arg) THEN
  653.     ADDRESS COMMAND 'C:DELETE >*' bbspath'EmailFiles/'arg 'ALL'
  654.   CALL send2log('Killed:' arg)
  655.   SAY CR'User file, Email & EmailFiles for' arg 'have been deleted.'CR
  656.   killcount=killcount+1
  657.   arg=''
  658. END
  659. IF killcount=0 THEN RETURN
  660. CALL DELETE(bbspath'Lists/USERS')
  661. sortuserflag=1
  662. RETURN
  663.  
  664.  
  665. menus:
  666. CALL checkdcd()
  667. SAY CR
  668. IF menu='NEW' THEN
  669. DO
  670.   SAY pen6'     _________________'def||CR
  671.   SAY pen6'  __/  'pen3'New User Menu'pen6'  \___'def||CR
  672.   SAY pen6' |                        |'def||CR
  673.   SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  674.   SAY pen6' |'def'   ['pen3'I'def']nformation        'pen6'|'def||CR
  675.   SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
  676.   SAY pen6' |'def'   ['pen3'W'def']ho is here        'pen6'|'def||CR
  677.   SAY pen6' |'def'   ['pen3'S'def']earch user list   'pen6'|'def||CR
  678.   SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
  679.   SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
  680.   SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
  681.   SAY pen6' |'def'   ['pen3'X'def'] toggle menus     'pen6'|'def||CR
  682.   SAY pen6' |'def'   ['pen3'#'def'] toggle color     'pen6'|'def||CR
  683.   SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
  684.   SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
  685.   SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
  686.   SAY pen6' |________________________|'def||CR
  687. END
  688. ELSE IF menu='MSG' THEN
  689. DO
  690.     SAY pen6'       ____________'def||CR
  691.     SAY pen6'  ____/  'pen3'Messages'pen6'  \_____'def||CR
  692.     SAY pen6' |                       |'def||CR
  693.     SAY pen6' |'def'   ['pen3'H'def']elp              'pen6'|'def||CR
  694.     SAY pen6' |'def'   ['pen3'P'def']ost messages     'pen6'|'def||CR
  695.     SAY pen6' |'def'   ['pen3'R'def']ead messages     'pen6'|'def||CR
  696.     SAY pen6' |'def'   ['pen3'S'def']earch messages   'pen6'|'def||CR
  697.     SAY pen6' |'def'   ['pen3'E'def']mail (private)   'pen6'|'def||CR
  698.     SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP  'pen6'|'def||CR
  699.     SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP  'pen6'|'def||CR
  700. IF(level>sysoplevel) THEN DO
  701.     SAY pen6' |'def'   ['pen3'^'def'] view BBS logs   'pen6'|'def||CR
  702.     SAY pen6' |'def'   ['pen3')'def'] email report    'pen6'|'def||CR
  703.     SAY pen6' |'def'   ['pen3'='def'] level report    'pen6'|'def||CR
  704.     SAY pen6' |'def'   ['pen3';'def'] change username 'pen6'|'def||CR;END
  705. IF(level=99) THEN DO
  706.     SAY pen6' |'def'   ['pen3'~'def'] online editor   'pen6'|'def||CR
  707.     SAY pen6' |'def'   ['pen3'@'def'] dos shell       'pen6'|'def||CR;END
  708.     SAY pen6' |'def'   ['pen3'F'def']iles menu        'pen6'|'def||CR
  709.     SAY pen6' |'def'   ['pen3'.'def'] main menu       'pen6'|'def||CR
  710.     SAY pen6' |_______________________|'def||CR
  711. END
  712. ELSE IF menu='FILE' THEN
  713. DO
  714.     SAY pen6'         _________'def||CR
  715.     SAY pen6'  ______/  'pen3'Files'pen6'  \_______'def||CR
  716.     SAY pen6' |                        |'def||CR
  717.     SAY pen6' |'def'   ['pen3'A'def']lphabetic list    'pen6'|'def||CR
  718.     SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  719.     SAY pen6' |'def'   ['pen3'B'def']rowse filenotes   'pen6'|'def||CR
  720.     SAY pen6' |'def'   ['pen3'N'def']ew files list     'pen6'|'def||CR
  721.     SAY pen6' |'def'   ['pen3'L'def']ist by Library    'pen6'|'def||CR
  722.     SAY pen6' |'def'   ['pen3'S'def']earch files       'pen6'|'def||CR
  723.     SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
  724.     SAY pen6' |'def'   ['pen3'U'def']pload             'pen6'|'def||CR
  725.     SAY pen6' |'def'   ['pen3'D'def']ownload           'pen6'|'def||CR
  726.     SAY pen6' |'def'   ['pen3'T'def']ransfer protocol  'pen6'|'def||CR
  727.     SAY pen6' |'def'   ['pen3'+'def'] Extra Devices    'pen6'|'def||CR
  728. IF(level>sysoplevel) THEN DO
  729.     SAY pen6' |'def'   ['pen3'K'def']ill a user        'pen6'|'def||CR
  730.     SAY pen6' |'def'   ['pen3'%'def'] edit filenote    'pen6'|'def||CR
  731.     SAY pen6' |'def'   ['pen3'('def'] file report      'pen6'|'def||CR
  732.     SAY pen6' |'def'   ['pen3';'def'] change username  'pen6'|'def||CR;END
  733. IF(level=99) THEN DO
  734.     SAY pen6' |'def'   ['pen3'@'def'] dos shell        'pen6'|'def||CR;END
  735.     SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
  736.     SAY pen6' |'def'   ['pen3'.'def'] main menu        'pen6'|'def||CR
  737.     SAY pen6' |________________________|'def||CR
  738. END
  739. ELSE IF menu='MAIN' THEN
  740. DO
  741.     SAY pen6'       _____________'def||CR
  742.     SAY pen6'  ____/  'pen3'Main Menu'pen6'  \_____'def||CR
  743.     SAY pen6' |                        |'def||CR
  744.     SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  745.     SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def||CR
  746.     SAY pen6' |'def'   ['pen3'J'def']ump to doorways   'pen6'|'def||CR
  747.     SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
  748.     SAY pen6' |'def'   ['pen3'W'def']ho is here list   'pen6'|'def||CR
  749.     SAY pen6' |'def'   ['pen3'S'def']earch userlist    'pen6'|'def||CR
  750.     SAY pen6' |'def'   ['pen3'O'def']ther users info   'pen6'|'def||CR
  751.     SAY pen6' |'def'   ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
  752.     SAY pen6' |'def'   ['pen3'#'def'] toggle colors    'pen6'|'def||CR
  753.     SAY pen6' |'def'   ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
  754.     SAY pen6' |'def'   ['pen3'&'def'] user profiles    'pen6'|'def||CR
  755.     SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
  756.     SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
  757.     SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
  758.     SAY pen6' |'def'   ['pen3'F'def']iles menu         'pen6'|'def||CR
  759.     SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
  760.     SAY pen6' |________________________|'def||CR
  761. END
  762. ELSE IF menu='ALL' THEN
  763. DO
  764.     SAY pen6'     __________________________________________________________'def||CR
  765.     SAY pen6'  __/   'pen3'Main Menu            File Menu          Message Menu 'pen6'  \__'def||CR
  766.     SAY pen6' |                                                                |'def||CR
  767.     SAY pen6' |'def' ['pen3'H'def']elp               ['pen3'A'def']lphabetical list  ['pen3'P'def']ost messages      'pen6'|'def||CR
  768.     SAY pen6' |'def' ['pen3'I'def']nformation        ['pen3'B'def']rowse filenotes   ['pen3'R'def']ead messages      'pen6'|'def||CR
  769.     SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics   ['pen3'L'def']ist by Library    ['pen3'E'def']mail (private)    'pen6'|'def||CR
  770.     SAY pen6' |'def' ['pen3'Y'def']our user data     ['pen3'N'def']ew files          ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
  771.     SAY pen6' |'def' ['pen3'O'def']ther users info   ['pen3'D'def']ownload           ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
  772.     SAY pen6' |'def' ['pen3'J'def']ump to doorways   ['pen3'U'def']pload             ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
  773.     SAY pen6' |'def' ['pen3'S'def']earch menu        ['pen3'T'def']ransfer protocol  ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
  774.     SAY pen6' |'def' ['pen3'&'def'] user profiles    ['pen3'+'def'] Extra Devices    ['pen3'#'def'] toggle colors    'pen6'|'def||CR
  775.     SAY pen6' |'def' ['pen3'G'def']oodbye (logoff)   ['pen3'V'def']iew user log      ['pen3','def'] hourly stats     'pen6'|'def||CR
  776. IF(level>sysoplevel) THEN DO
  777.     SAY pen6' |'def' ['pen3'K'def']ill a user        ['pen3'%'def'] edit filenote    ['pen3'='def'] level report     'pen6'|'def||CR
  778.     SAY pen6' |'def' ['pen3'^'def'] view BBS logs    ['pen3'('def'] file report      ['pen3';'def'] change username  'pen6'|'def||CR;END
  779. IF(level=99) THEN
  780.     SAY pen6' |'def' ['pen3'~'def'] online editor    ['pen3'@'def'] dos shell        ['pen3')'def'] email report     'pen6'|'def||CR
  781.     SAY pen6' |________________________________________________________________|'def||CR
  782. END
  783. QUEUE CR  /* clears any un-CRed input in the queue */
  784. RETURN
  785.  
  786.  
  787. help:
  788. ARG helppath .
  789. SAY CR
  790. SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'CR
  791. IF helppath='MAIN' THEN
  792.   SAY 'Commands available from the' pen3||menu||def 'menu:'CR
  793. frontend=bbspath'BBS_HELP/'helppath
  794. backend='.USER'
  795. IF level=0 THEN backend='.NEW'
  796. ELSE IF level=99 THEN backend='.SUPER'
  797. ELSE IF level>sysoplevel THEN backend='.SYSOP'
  798. CALL showtext(frontend||backend)
  799. RETURN
  800.  
  801.  
  802. waiting:
  803. CALL checktime()
  804. IF waitchar='Q' THEN
  805.   DO
  806.     waitchar=''
  807.     RETURN
  808.   END
  809. waitchar=''
  810. IF nonstop=1 THEN RETURN
  811. OPTIONS PROMPT pen3'                       RETURN=Continue 'def
  812. PULL waitchar
  813. CALL cleanline(1)
  814. CALL checkdcd()
  815. RETURN
  816.  
  817.  
  818. waiting2:
  819. CALL checktime()
  820. IF nonstop=1 THEN RETURN 0
  821. waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
  822. IF waitchar='N' THEN
  823.   DO
  824.     nonstop=1
  825.     SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
  826.     SAY CR
  827.     CALL DELAY(100)
  828.     waitchar=''
  829.   END
  830. CALL cleanline(1)
  831. CALL checkdcd()
  832. IF waitchar='Q' THEN RETURN 1
  833. RETURN 0
  834.  
  835.  
  836. cleanline:
  837. ARG lflag .
  838. IF colorflag~=1 & lflag=1 THEN RETURN
  839. cline=lineup||LEFT(' ',78)
  840. IF lflag=1 THEN cline=cline||lineup
  841. SAY cline||CR
  842. RETURN
  843.  
  844.  
  845. getinput:
  846. PARSE ARG upflag' 'oneflag' 'pline
  847. CALL checkdcd()
  848. OPTIONS PROMPT pline
  849. PARSE PULL inarg
  850. inarg=STRIP(inarg)
  851. IF upflag THEN inarg=UPPER(inarg)
  852. IF oneflag THEN inarg=LEFT(inarg,1)
  853. inarg=cleanstring(0':'inarg)
  854. RETURN inarg
  855.  
  856.  
  857. docity:
  858. PARSE ARG citi
  859. citi=TRANSLATE(citi,'          ','+-.,*/()<>')
  860. DO i=WORDS(citi) TO 1 BY -1
  861.   IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  862.   IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
  863. END
  864. citi=SPACE(citi,1)
  865. RETURN STRIP(citi)
  866.  
  867.  
  868. postuser:
  869. IF bbsprefs.12~=1 THEN RETURN
  870. ARG upflag .
  871. IF upflag=6 THEN ptext='Logoff:' DATE() TIME('C')'  'name city
  872. ELSE IF upflag=7 THEN ptext=name'  is a NEW USER!'
  873. ELSE ptext=name city'  On:' logontime'  Last On:' DATE(,lastondate,'I')
  874. ptext=CENTER(ptext,74)'\'
  875. age='?'
  876. IF UPPER(WORD(data.12,3))='BIRTHDAY:' THEN
  877.   DO
  878.     IF DATATYPE(WORD(data.12,4),'N') THEN
  879.       DO
  880.         age=LEFT(DATE('S'),4)-LEFT(WORD(data.12,4),4)
  881.         IF SUBSTR(DATE('S'),5,2)<SUBSTR(WORD(data.12,4),5,2) THEN age=age-1
  882.       END
  883.   END
  884. IF age='?' & WORD(data.12,4)~='' THEN age=WORD(data.12,4)
  885. ptext2='Baud:' bps'   Age:' age'   Usage:' data.19
  886. IF chatrequest=1 THEN ptext2=ptext2' - CHAT REQUEST!'
  887. ptext=ptext||CENTER(ptext2,74)'\'
  888. ulb=WORD(data.14,3)
  889. IF ~DATATYPE(ulb,'N') | ulb=0 THEN ulb=1
  890. dlb=WORD(data.15,3)
  891. IF ~DATATYPE(dlb,'N') THEN dlb=0
  892. dlup=TRUNC(dlb/ulb+.005,2)
  893. line3='Level: 'level'   dl/ul:' dlup
  894. IF upflag=0 THEN ptext=ptext||CENTER(line3,74)
  895. IF upflag=1 THEN ptext=ptext||CENTER(line3'   Cmd:' opt arg,74)
  896. IF upflag=2 THEN ptext=ptext||CENTER(line3'   MSG:' msg.msgdir,74)
  897. IF upflag=3 THEN ptext=ptext||CENTER(line3'   Email',74)
  898. IF upflag=4 THEN ptext=ptext||CENTER(line3'   ul:' arg 'in' plaindir,74)
  899. IF upflag=5 THEN ptext=ptext||CENTER(line3'   dl:' arg 'in' plaindir,74)
  900. IF upflag=6 THEN
  901.   DO
  902.     line3=line3'   Elapsed:'elapsed' '
  903.     IF EXISTS(bbspath'Email/'sysop'/NEW_FILES') THEN line3=line3 'NEW_FILES'
  904.     IF EXISTS(bbspath'Lists/NEW_USERS') THEN line3=line3 'NEW_USERS'
  905.     ptext=ptext||CENTER(line3,74)
  906.   END
  907. CALL PostMsg(3,14,ptext)
  908. RETURN
  909.  
  910.  
  911. whodat:
  912. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  913. RETURN
  914.  
  915.  
  916. showtime:
  917. mins=TIME('E')%60
  918. secs=TRUNC(TIME('E')//60)+1
  919. IF secs>59 THEN secs=59
  920. IF secs<10 THEN secs='0'secs
  921. line=' Time:  Used' mins':'secs
  922. mins=(maxtime-TIME('E'))%60
  923. secs=TRUNC((maxtime-TIME('E'))//60)
  924. IF secs<10 THEN secs='0'secs
  925. line=line'   Remaining' mins':'secs
  926. SAY line||CR
  927.  
  928. checktime:
  929. IF TIME('E')>maxtime THEN
  930.   DO
  931.     SAY 'Sorry,' name 'your time has expired.'CR
  932.     CALL send2log('*** Time Expired ***')
  933.     SIGNAL LOGOUT2
  934.   END
  935. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  936. CALL whodat()
  937. CALL checkdcd()
  938. RETURN
  939.  
  940.  
  941. setdir:
  942. PARSE ARG tempdir
  943. CALL PRAGMA('D',STRIP(tempdir))
  944. directory=PRAGMA('D')
  945. Data directory
  946. slash=LASTPOS('/',directory)
  947. IF slash=0 THEN slash=LASTPOS(':',directory)
  948. plaindir=directory
  949. IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
  950. RETURN
  951.  
  952.  
  953. config:
  954. arg='s:CONFIG.BBS'
  955. IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
  956. IF readlines(arg 1) THEN
  957.   DO
  958.     SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'
  959.     SIGNAL DONE2
  960.   END
  961. compos=POS('/*',lynes.1)
  962. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  963. bbsname=STRIP(lynes.1)
  964. sysop=WORD(lynes.2,1)
  965. compos=POS('/*',lynes.3)
  966. IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
  967. exclusion=STRIP(lynes.3)
  968. bbsdevice=WORD(lynes.4,1)
  969. sysoplevel=WORD(lynes.5,1)
  970. bbspath=WORD(lynes.6,1)
  971. IF ~EXISTS(bbspath) THEN
  972.   DO
  973.     SAY bbspath 'does not exist!'
  974.     SIGNAL DONE2
  975.   END
  976. testchar=RIGHT(bbspath,1)
  977. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  978. CALL SETCLIP('BBS_path',bbspath)
  979. msgpath=WORD(lynes.7,1)
  980. IF ~EXISTS(msgpath) THEN
  981.   DO
  982.     SAY msgpath 'does not exist!'
  983.     SIGNAL DONE2
  984.   END
  985. testchar=RIGHT(msgpath,1)
  986. IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
  987. CALL SETCLIP('BBS_msgpath',msgpath)
  988. msgpath=msgpath'MSG'
  989. libpath=WORD(lynes.8,1)
  990. IF ~EXISTS(libpath) THEN
  991.   DO
  992.     SAY libpath 'does not exist!'
  993.     SIGNAL DONE2
  994.   END
  995. testchar=RIGHT(libpath,1)
  996. IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
  997. CALL SETCLIP('BBS_libpath',libpath)
  998. spellpath=WORD(lynes.9,1)
  999. IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  1000.   DO
  1001.     SAY spellpath 'does not exist!'
  1002.     bbsprefs.5=0
  1003.   END
  1004. extdevs=''
  1005. DO i=1 TO WORDS(lynes.10)
  1006.   test=WORD(lynes.10,i)
  1007.   IF POS(':',test)=0 THEN ITERATE i
  1008.   IF LEFT(test,2)='/*' THEN LEAVE i
  1009.   extdevs=STRIP(extdevs test)
  1010. END
  1011. SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
  1012. SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
  1013. maxidle=WORD(lynes.13,1)
  1014. maxtime=WORD(lynes.14,1)
  1015. maxbps=WORD(lynes.15,1)
  1016. IF ~DATATYPE(maxbps,'N') THEN maxbps=2400
  1017. CALL SETCLIP('BBS_baud',maxbps)
  1018. DO i=16 TO 31
  1019.   j=i-15
  1020.   bbsprefs.j=STRIP(WORD(lynes.i,1))
  1021. END
  1022. IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  1023.   DO
  1024.     SAY spellpath 'does not exist!'CR
  1025.     bbsprefs.5=0
  1026.   END
  1027. IF bbsprefs.10 THEN scratch=bbspath'Scratch'
  1028. ELSE scratch='RAM:Scratch'
  1029. CALL MAKEDIR(scratch)
  1030. IF ~DATATYPE(bbsprefs.16,'N') THEN bbsprefs.16=3
  1031. extension=WORD(lynes.32,1)
  1032. arccom=lynes.33
  1033. compos=POS('/*',lynes.33)
  1034. IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
  1035. arccom=STRIP(lynes.33)
  1036. IF LEFT(extension,1)~='.' THEN
  1037.   DO
  1038.     extension='.lzh'
  1039.     arccom='lharc -m m'
  1040.   END
  1041. RETURN
  1042.  
  1043.  
  1044. readlogs:
  1045. IF arg='' THEN
  1046.   arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
  1047. IF arg='' THEN arg=DATE('S')
  1048. arg=bbspath'Logs/log.'arg
  1049. CALL readlines(arg 1)
  1050. CALL seelines(0)
  1051. nonstop=0
  1052. CALL waiting()
  1053. RETURN
  1054.  
  1055.  
  1056. loadcourtesy:
  1057. IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
  1058.   DO
  1059.     IF readopen(bbspath'Lists/Courtesy') THEN
  1060.       DO
  1061.         SAY 'Checking Courtesy List...'CR
  1062.         DO i=1
  1063.           line=READLN(f)
  1064.           IF EOF(f) THEN BREAK
  1065.           line=cleanstring(1':'line)
  1066.           courtesy=courtesy line
  1067.         END
  1068.         CALL CLOSE(f)
  1069.         MSG ''
  1070.         MSG pen3'Courtesy List:'def
  1071.         MSG courtesy
  1072.       END
  1073.   END
  1074. RETURN
  1075.  
  1076.  
  1077. fileheader:
  1078. SAY 'Filename          Bytes File# Library         KeyWords'CR
  1079. SAY pen3||LEFT('=',77,'=')||def||CR
  1080. RETURN
  1081.  
  1082.  
  1083. showalpha:
  1084. IF DATATYPE(arg,'N') THEN
  1085.   DO
  1086.     dirnum=arg
  1087.     arg=''
  1088.     IF chdir2()>0 THEN RETURN
  1089.     test='Y'
  1090.   END
  1091. ELSE
  1092.   DO
  1093.     test=getinput(1 1 'Show one library only? (Ny) > ')
  1094.     IF test='Y' THEN
  1095.       IF chdir()>0 THEN RETURN
  1096.   END
  1097.  
  1098. showalpha2:
  1099. IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
  1100. ELSE filecount=files.0
  1101. SAY '  'filecount 'files.'CR
  1102. CALL fileheader()
  1103. count=0
  1104. DO shi=1 TO alpha.0
  1105.   IF test='Y' THEN
  1106.     DO
  1107.       IF count>=filecount THEN LEAVE shi
  1108.       IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.shi,5),12)) THEN
  1109.         ITERATE shi
  1110.     END
  1111.   jj=WORD(alpha.shi,4)
  1112.   IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
  1113.     ITERATE shi
  1114.   SAY alpha.shi||CR
  1115.   count=count+1
  1116.   IF (count+2)//linesperpage=0 THEN
  1117.     IF waiting2() THEN LEAVE shi
  1118. END
  1119. nonstop=0
  1120. IF waitchar~='Q' THEN CALL waiting()
  1121. RETURN
  1122.  
  1123.  
  1124. profiles:
  1125. prodir=bbspath'Profiles'
  1126. CALL MAKEDIR(prodir)
  1127. pros=SHOWDIR(prodir)
  1128. protxt=bbspath'BBS_TEXT/PROFILES'
  1129. IF EXISTS(protxt) THEN CALL showtext(protxt)
  1130. DO lupe=1
  1131.   SAY CR
  1132.   SAY '       1. Edit 'name'''s user Profile'CR
  1133.   SAY '       2. View a User Profile'CR
  1134.   SAY '       3. Search User Profiles'CR
  1135.   SAY '       4. Browse User Profiles'CR
  1136.   SAY CR
  1137.   temp=getinput(1 1 'Enter Selection Number > ')
  1138.   IF temp=1 THEN
  1139.     DO
  1140.       lynes.=''
  1141.       IF EXISTS(prodir'/'name) THEN
  1142.         DO
  1143.           IF readlines(prodir'/'name 1)~=0 THEN ITERATE lupe
  1144.           CALL DELETE(prodir'/'name)
  1145.         END
  1146.       ELSE lynes.0=3
  1147.       lynes.1=name
  1148.       lynes.2='Profile Last Updated:' DATE('W') DATE() TIME('C')
  1149.       lynes.3=LEFT('=',74,'=')
  1150.       IF savelines(prodir'/'name)~=0 THEN
  1151.         DO
  1152.           line='Profile for' name 'failed to save!'
  1153.           SAY line||CR
  1154.           CALL send2log(line)
  1155.           ITERATE lupe
  1156.         END
  1157.       edtype=''
  1158.       CALL bbsEd(4 prodir'/'name)
  1159.       IF readlines(prodir'/'name 1)~=0 THEN CALL DELETE(prodir'/'name)
  1160.       IF lynes.0<4 THEN CALL DELETE(prodir'/'name)
  1161.       pros=SHOWDIR(prodir)
  1162.     END
  1163.   ELSE IF temp=2 THEN
  1164.     DO pf=1
  1165.       totpros=WORDS(pros)
  1166.       DO pfl=1 TO totpros BY 3
  1167.         pfl2=pfl+1
  1168.         pfl3=pfl+2
  1169.         pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(pros,pfl),21)
  1170.         IF pfl2<=totpros THEN
  1171.           pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(pros,pfl2),21)
  1172.         IF pfl3<=totpros THEN
  1173.           pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(pros,pfl3),21)
  1174.         SAY pfline||CR
  1175.         IF nonstop~=1 & ((pfl3%3)//linesperpage)=0 THEN
  1176.           IF waiting(2) THEN LEAVE pfl1
  1177.       END
  1178.       emnum=getinput(1 0 pen3'Select User Profile Number > 'def)
  1179.       IF DATATYPE(emnum,'N') & emnum>0 & emnum<=totpros THEN
  1180.         DO
  1181.           tmp=WORD(pros,emnum)
  1182.           IF level>sysoplevel THEN
  1183.             DO
  1184.               CALL bbsEd(1 prodir'/'tmp)
  1185.               IF readlines(prodir'/'tmp 1)~=0 THEN CALL DELETE(prodir'/'tmp)
  1186.               IF lynes.0<4 THEN CALL DELETE(prodir'/'tmp)
  1187.               pros=SHOWDIR(prodir)
  1188.             END
  1189.           ELSE CALL showtext(prodir'/'tmp)
  1190.         END
  1191.       ELSE LEAVE pf
  1192.     END
  1193.   ELSE IF temp=3 | temp=4 THEN
  1194.     DO
  1195.       searcharg=''
  1196.       nonstop=0
  1197.       IF temp=3 THEN
  1198.         DO
  1199.           searcharg=STRIP(getinput(0 0 'Enter Search Phrase > '))
  1200.           IF searcharg='' THEN ITERATE lupe
  1201.         END
  1202.       DO ui=1 TO WORDS(pros)
  1203.         pro=prodir'/'WORD(pros,ui)
  1204.         IF temp=3 THEN
  1205.           IF textsearch(pro searcharg)=0 THEN ITERATE ui
  1206.         SAY CR
  1207.         CALL readlines(pro 1)
  1208.         IF nonstop=1 THEN rnonstop=1
  1209.         ELSE rnonstop=0
  1210.         CALL seelines(2)
  1211.         IF rnonstop THEN nonstop=1
  1212.         ELSE IF waiting2()=1 THEN LEAVE ui
  1213.         SAY CR
  1214.         SAY CR
  1215.       END
  1216.     END
  1217.   ELSE IF temp='' | LEFT(temp,1)='Q' THEN LEAVE lupe
  1218. END
  1219. DROP pros
  1220. RETURN
  1221.  
  1222.  
  1223. otheruser:
  1224. line=''
  1225. IF level>sysoplevel THEN line='['pen3'R'def']eport or'
  1226. line=line '['pen3'D'def']etails or simple ['pen3'N'def']amelist?'
  1227. IF level>sysoplevel THEN line=line '(Dnr) > '
  1228. ELSE line=line '(Dn) > '
  1229. temp=getinput(1 1 line)
  1230. IF temp='N' THEN
  1231.   DO
  1232.     CALL showuserlist()
  1233.     RETURN
  1234.   END
  1235. ELSE IF level>sysoplevel & temp='R' THEN
  1236.   DO
  1237.     SAY CR
  1238.     line=''
  1239.     IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
  1240.       DO
  1241.         CALL cleanline(0)
  1242.         SAY 'INACTIVE_USERS report will be in your email.'CR
  1243.         line='USERS '
  1244.       END
  1245.     IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
  1246.       DO
  1247.         CALL cleanline(0)
  1248.         line=line'FILES'
  1249.         line=STRIP(line getinput(1 0 'Report only files larger than (0) bytes > '))
  1250.         SAY 'FILELISTS_REPORT will be in your email.'CR
  1251.       END
  1252.     SAY CR
  1253.     ADDRESS AREXX bbsREPORT.rexx name line 
  1254.     RETURN
  1255.   END
  1256. SAY CR
  1257. SAY 'To allow (or not) other users to see your street address and/or phone number,'CR
  1258. SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR
  1259. SAY CR
  1260. SAY 'User specification may include ? wildcard for single characters.'CR
  1261. SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR
  1262. IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def)
  1263. IF arg='' THEN RETURN
  1264. arg=TRANSLATE(STRIP(arg),'_',' ')
  1265. CALL FileList(bbspath'Users/*'arg'*',wildlist)
  1266. line='Found' wildlist.0 'match'
  1267. IF wildlist.0~=1 THEN line=line'es'
  1268. SAY line'.'CR
  1269. IF wildlist.0<1 THEN RETURN
  1270. totlines=0
  1271. nextpagebreak=linesperpage-3
  1272. extrainfo=0
  1273. IF level>sysoplevel THEN
  1274.   DO
  1275.     IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
  1276.       extrainfo=1
  1277.   END
  1278. DO i=1 TO wildlist.0
  1279.   CALL readlines(wildlist.i 1)
  1280.   SAY CR
  1281.   totlines=totlines+6
  1282.   SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def||CR
  1283.   SAY lynes.1||CR
  1284.   IF FIND(UPPER(lynes.8),'STREET')>0 THEN
  1285.     DO
  1286.       totlines=totlines+1
  1287.       SAY lynes.2||CR
  1288.     END
  1289.   SAY lynes.3||CR
  1290.   IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
  1291.     DO
  1292.       totlines=totlines+1
  1293.       SAY lynes.4||CR
  1294.     END
  1295.   SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR
  1296.   SAY pen3'Interests:'def lynes.10||CR
  1297.   IF extrainfo THEN
  1298.     DO
  1299.       SAY pen3'   up:'def lynes.14||CR
  1300.       SAY pen3' down:'def lynes.15||CR
  1301.       temptot=0
  1302.       DO j=1 TO WORDS(lynes.23)
  1303.         IF DATATYPE(WORD(lynes.23,j),'N') THEN temptot=temptot+WORD(lynes.23,j)
  1304.       END
  1305.       SAY pen3' writ:'def temptot 'public messages.'CR
  1306.       SAY pen3'level:'def lynes.20||CR
  1307.       totlines=totlines+4
  1308.       IF lynes.21~='' THEN
  1309.         DO
  1310.           totlines=totlines+1
  1311.           SAY pen3'excluded dirs:'def lynes.21||CR
  1312.         END
  1313.     END
  1314.   IF nonstop~=1 & totlines>=nextpagebreak THEN
  1315.     DO
  1316.       IF waiting2() THEN LEAVE i
  1317.       nextpagebreak=totlines+linesperpage-5
  1318.     END
  1319. END
  1320. nonstop=0
  1321. DROP wildlist.
  1322. IF waitchar~='Q' THEN CALL waiting()
  1323. RETURN
  1324.  
  1325.  
  1326. changename:
  1327. ARG cname
  1328. IF level<=sysoplevel THEN RETURN
  1329. IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
  1330. IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
  1331. IF WORD(lynes,20)>=level THEN RETURN
  1332. CALL SETCLIP('BBS_oldname',cname)
  1333. CALL ChangeUserName.rexx()
  1334. IF GETCLIP('BBS_oldname')='' THEN CALL send2log('Name Change:' cname)
  1335. cname=GETCLIP('BBS_newname')
  1336. CALL DELETE(bbspath'Lists/USERS')
  1337. sortuserflag=1
  1338. CALL SETCLIP('BBS_oldname')
  1339. CALL SETCLIP('BBS_newname')
  1340. RETURN cname
  1341.  
  1342.  
  1343. levelreport:
  1344. minlev=0
  1345. maxlev=99
  1346. templist=''
  1347. newufile=bbspath'Lists/NEW_USERS'
  1348. IF EXISTS(newufile) THEN
  1349.   DO
  1350.     IF getinput(1 1 'Latest New Users Only? (nY) > ')~='N' THEN
  1351.       DO
  1352.         IF readlines(newufile 1)=0 THEN
  1353.           DO i=2 TO lynes.0
  1354.             templist=STRIP(templist WORD(lynes.i,5))
  1355.           END
  1356.       END
  1357.     ELSE newufile=''
  1358.   END
  1359. ELSE newufile=''
  1360. IF newufile='' THEN
  1361.   DO
  1362.     minlev=getinput(1 0 'Minimum level? (0) > ')
  1363.     maxlev=getinput(1 0 'Maximum level? (99) > ')
  1364.     IF ~DATATYPE(minlev,'N') THEN minlev=0
  1365.     IF ~DATATYPE(maxlev,'N') THEN maxlev=99
  1366.     IF minlev<0 | minlev>99 THEN minlev=0
  1367.     IF maxlev<0 | maxlev>99 THEN maxlev=99
  1368.     templist=userlist
  1369.   END
  1370. DO levi=1 TO WORDS(templist)
  1371.   arg=bbspath'Users/'WORD(templist,levi)
  1372.   CALL readlines(arg 1)
  1373.   IF lynes.20<minlev | lynes.20>maxlev THEN ITERATE levi
  1374.   line=lynes.20 WORD(templist,levi)
  1375.   SAY line||CR
  1376.   IF ~DATATYPE(WORD(lynes.20,1),'N') | WORD(lynes.20,1)<10 THEN
  1377.     DO
  1378.       SAY CR||LF||line||CR
  1379.       DO levj=1 TO 12
  1380.         SAY pen3'  'lynes.levj||def||CR
  1381.       END
  1382.       SAY pen3'  'lynes.19||def||CR
  1383.       lcom=getinput(1 1 '['pen3'A'def']dd or ['pen3'K'def']ill or ['pen3'R'def']ename or ['pen3'S'def']kip this user? (Akrs) > ')
  1384.       CALL cleanline(0)
  1385.       IF lcom='K' THEN
  1386.         DO
  1387.           arg=WORD(templist,levi)
  1388.           CALL killuser()
  1389.         END
  1390.       ELSE IF lcom='R' THEN
  1391.         DO
  1392.           newname=changename(WORD(templist,levi))
  1393.           IF newname~='' & newname~=WORD(templist,levi) THEN
  1394.             DO
  1395.               temp=WORDINDEX(templist,levi+1)
  1396.               rtemp=''
  1397.               IF temp>0 THEN rtemp=SUBSTR(templist,temp)
  1398.               temp=WORDINDEX(templist,levi)
  1399.               templist=''
  1400.               IF temp>1 THEN templist=STRIP(LEFT(templist,temp-1))
  1401.               templist=STRIP(templist newname rtemp)
  1402.               userlist=userlist newname
  1403.             END
  1404.           levi=levi-1
  1405.           CALL SETCLIP('BBS_newname')
  1406.         END
  1407.       ELSE IF lcom~='S' THEN
  1408.         DO
  1409.           IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
  1410.             DO
  1411.               DO lvi=1 TO 21
  1412.                 line=READLN(f)
  1413.                 IF lvi=11 THEN lynes.11=line
  1414.                 IF lvi=20 THEN lynes.20=line
  1415.               END
  1416.               lynes.21=line
  1417.               CALL CLOSE(f)
  1418.               edtype=''
  1419.               CALL savelines(arg)
  1420.               SAY lynes.20 WORD(templist,levi) 'has been made a member.'CR
  1421.             END
  1422.           ELSE SAY 'You need a default member file in BBS_TEXT!  ( BBS_TEXT/DEF.MEMBER )'CR
  1423.         END
  1424.       IF lcom~='K' & lcom~='R' THEN
  1425.         DO
  1426.           arg=WORD(templist,levi)
  1427.           IF getinput(1 1 'Write' arg 'an email message? (nY) > ')~='N' THEN
  1428.             DO
  1429.               IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
  1430.                 IF getinput(1 1 'Use default welcome? (nY) > ')~='N' THEN
  1431.                   replysubj='|@NEW@|'
  1432.               CALL editor('MAIL' arg)
  1433.             END
  1434.        END
  1435.     END
  1436. END
  1437. IF newufile~='' THEN CALL DELETE(newufile)
  1438. DROP templist
  1439. RETURN
  1440.  
  1441.  
  1442. filereport:
  1443. SAY 'Searching for mismatches between files and filenotes...'CR
  1444. DO i=1 TO sysoplevel+1
  1445.   IF dirs.i='' THEN ITERATE
  1446.   SAY dirs.i'                               'lineup||CR
  1447.   rfiles=SHOWDIR(libpath||dirs.i)
  1448.   rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
  1449.   IF WORDS(rfiles)~=WORDS(rnotes) THEN
  1450.     DO
  1451.       line='Compare files & filenotes in'pen3 dirs.i||def'. '
  1452.       DO j=1 TO WORDS(rfiles)
  1453.         IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
  1454.           line=line WORD(rfiles,j)
  1455.       END
  1456.       SAY line||CR
  1457.     END
  1458. END
  1459. Send '^G'
  1460. CALL waiting()
  1461. RETURN
  1462.  
  1463.  
  1464. mailreport:
  1465. SAY 'Checking ALL pending Email...'CR
  1466. SAY pen3' - Use CTRL-E to Exit -'def||CR
  1467. SAY CR
  1468. mailrep=SHOWDIR(bbspath'Email','D')
  1469. mailfil=SHOWDIR(bbspath'EmailFiles','D')
  1470. lastemail=WORD(data.17,3)
  1471. IF ~DATATYPE(lastemail,'N') THEN lastemail=0
  1472. IF lastemail=countcheck(bbspath'Numbers/LastMail' 0) THEN
  1473.   DO
  1474.     DROP mailrep. mailfil.
  1475.     RETURN
  1476.   END
  1477. mailynes.=''
  1478. mk=0
  1479. DO mi=1 TO WORDS(mailrep)
  1480.   muser=WORD(mailrep,mi)
  1481.   IF muser=sysop | muser=name THEN ITERATE mi
  1482.   mlist=SHOWDIR(bbspath'Email/'muser)
  1483.   IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)||CR
  1484.   DO mj=1 TO WORDS(mlist)
  1485.     fuser=WORD(mlist,mj)
  1486.     IF POS(sysop,fuser)>0 THEN ITERATE mj
  1487.     IF logonflag=0 THEN
  1488.       DO
  1489.         mk=mk+1
  1490.         mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
  1491.       END
  1492.     IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
  1493.       DO
  1494.         testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
  1495.         IF testnum>emailnum THEN emailnum=testnum
  1496.         IF testnum>lastemail THEN
  1497.           DO
  1498.             CALL showtext(bbspath'Email/'muser'/'fuser)
  1499.             SAY CR
  1500.             SAY CR
  1501.           END
  1502.       END
  1503.   END
  1504.   IF logonflag=0 & FIND(mailfil,muser)>0 THEN
  1505.     DO
  1506.       efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
  1507.       IF WORDS(efilelist)>0 THEN
  1508.         DO
  1509.           mk=mk+1
  1510.           mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
  1511.         END
  1512.     END
  1513. END
  1514. data.17=WORD(data.17,1) WORD(data.17,2) countcheck(bbspath'Numbers/LastMail' 0)
  1515. IF mk>0 THEN
  1516.   DO
  1517.     lynes.0=mk
  1518.     DO mi=1 TO mk
  1519.       lynes.mi=mailynes.mi
  1520.     END
  1521.     CALL seelines(1)
  1522.     nonstop=0
  1523.     CALL waiting()
  1524.   END
  1525. ELSE SAY 'No unseen Email pending.'CR
  1526. DROP mailrep. mailfil. mailynes. mlist
  1527. RETURN
  1528.  
  1529.  
  1530. jump2rexx:
  1531. IF ~DATATYPE(jdoors.0,'N') THEN doors.0=0
  1532. IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  1533.   DO
  1534.     jdoors.=''
  1535.     doorlist=SHOWDIR(bbspath'rexxDoors','F')
  1536.     doors.=''
  1537.     doors.0=WORDS(doorlist)
  1538.     DO i=1 TO doors.0
  1539.       doors.i=WORD(doorlist,i)
  1540.     END
  1541.     SAY 'Sorting..'lineup||CR
  1542.     CALL QSORT(1,doors.0,doors)
  1543.     jdoors.0=doors.0%3
  1544.     IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
  1545.     DO i=1 TO jdoors.0
  1546.       jdoors.i=LEFT(RIGHT(i,3)'.' LEFT(doors.i,LENGTH(doors.i)-5),24)
  1547.       DO j=1 TO 2
  1548.         k=i+j*jdoors.0
  1549.         IF k<=doors.0 THEN
  1550.           jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
  1551.       END
  1552.     END
  1553.   END
  1554. DO doorloop=1
  1555.   SAY pen3||LEFT('-',75,'-')||def||CR
  1556.   DO jd=1 TO jdoors.0
  1557.     SAY jdoors.jd||CR
  1558.     IF jd//linesperpage=0 THEN CALL waiting()
  1559.     IF waitchar='Q' THEN RETURN
  1560.   END
  1561.   temp=getinput(1 0 pen3'Select Application Number > 'def)
  1562.   IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN RETURN
  1563.   arg=doors.temp
  1564.   CALL postuser(1)
  1565.   curdir=PRAGMA('D')
  1566.   CALL setdir(bbspath'rexxDoors')
  1567.   CALL send2log('Door: 'doors.temp 'at' TIME('C'))
  1568.   CALL SETCLIP('BBS_winnings')
  1569.   savewinnings=0
  1570.   timeleft=TRUNC(maxtime-TIME('E'))
  1571.   IF UPPER(doors.temp)='ONE_ARMED_BANDIT.REXX' THEN
  1572.     IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN
  1573.       DO
  1574.         savewinnings=winnings
  1575.         IF savewinnings=0 THEN savewinnings=1
  1576.         winnings=timeleft
  1577.         SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
  1578.       END
  1579.   CALL SETCLIP('BBS_demon',timeleft)
  1580.   ADDRESS AREXX doorDemon.baud
  1581.   INTERPRET 'call' doors.temp'('name winnings savewinnings colorflag')'
  1582.   testwin=GETCLIP('BBS_winnings')
  1583.   IF DATATYPE(testwin,'N') THEN
  1584.     DO
  1585.       IF savewinnings>0 THEN
  1586.         DO
  1587.           IF testwin>7200 THEN
  1588.             DO
  1589.               SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
  1590.               testwin=7200
  1591.             END
  1592.           maxtime=TRUNC(testwin+TIME('E'))
  1593.           winnings=savewinnings
  1594.         END
  1595.       ELSE winnings=testwin
  1596.     END
  1597.   CALL setdir(curdir)
  1598.   CALL SETCLIP('BBS_winnings')
  1599.   IF SHOW('P','BBS_DEMON') THEN CALL SETCLIP('BBS_demon','QUIT')
  1600.   SAY CR
  1601.   CALL showtime()
  1602. END
  1603. RETURN
  1604.  
  1605.  
  1606. sortlibraries:
  1607. SAY 'Sorting Libraries...'lineup||CR
  1608. count=0
  1609. sdirs.=''
  1610. DO i=1 TO level
  1611.   IF dirs.i='' THEN ITERATE i
  1612.   count=count+1
  1613.   sdirs.count=dirs.i i
  1614. END
  1615. sdirs.0=count
  1616. CALL QSort(1,count,sdirs)
  1617. count=0
  1618. libs.=''
  1619. DO i=1 TO sdirs.0
  1620.   tempnum=WORD(sdirs.i,2)
  1621.   tempdir=WORD(sdirs.i,1)
  1622.   IF FIND(data.21,UPPER(tempdir))=0 THEN
  1623.     DO
  1624.       string=' '
  1625.       IF tempnum<10 THEN string=string' '
  1626.       string=string || tempnum'. 'LEFT(tempdir,14)
  1627.       count=count+1
  1628.       libs.count=string
  1629.     END
  1630. END
  1631. libs.0=count%4
  1632. IF (count//4)>0 THEN libs.0=libs.0+1
  1633. DO i=1 TO libs.0
  1634.   DO j=1 TO 3
  1635.     k=i+j*libs.0
  1636.     IF k<=count THEN libs.i=libs.i||libs.k
  1637.   END
  1638. END
  1639. DROP sdirs.
  1640. CALL sortconferences()
  1641. RETURN
  1642.  
  1643.  
  1644. sortconferences:
  1645. SAY 'Sorting Conferences...'lineup||CR
  1646. count=0
  1647. smsg.=''
  1648. DO i=1 TO level
  1649.   IF msg.i='' THEN ITERATE i
  1650.   count=count+1
  1651.   smsg.count=msg.i i
  1652. END
  1653. smsg.0=count
  1654. CALL QSort(1,count,smsg)
  1655. count=0
  1656. msgs.=''
  1657. DO i=1 TO smsg.0
  1658.   tempnum=WORD(smsg.i,2)
  1659.   tempdir=WORD(smsg.i,1)
  1660.   IF FIND(data.21,tempnum)=0 THEN
  1661.     DO
  1662.       string=' '
  1663.       IF tempnum<10 THEN string=string' '
  1664.       string=string || tempnum'.'
  1665.       IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
  1666.         string=string LEFT(tempdir,20)
  1667.       ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
  1668.       count=count+1
  1669.       msgs.count=string
  1670.     END
  1671. END
  1672. msgs.0=count%3
  1673. IF (count//3)>0 THEN msgs.0=msgs.0+1
  1674. DO i=1 TO msgs.0
  1675.   DO j=1 TO 2
  1676.     k=i+j*msgs.0
  1677.     IF k<=count THEN msgs.i=msgs.i msgs.k
  1678.   END
  1679. END
  1680. DROP smsg.
  1681. RETURN
  1682.  
  1683.  
  1684. readmessages:
  1685. searcharg=''
  1686. DO FOREVER
  1687.   SAY CR
  1688.   PARSE VAR arg temp' 'arg .
  1689.   IF DATATYPE(temp,'N') THEN msgdir=temp
  1690.   ELSE IF LEFT(UPPER(temp),1)='A' THEN
  1691.     DO
  1692.       CALL newmsgs()
  1693.       arg=''
  1694.       RETURN
  1695.     END
  1696.   ELSE IF LEFT(UPPER(temp),1)='M' THEN
  1697.     DO
  1698.       CALL readmarked()
  1699.       arg=''
  1700.       RETURN
  1701.     END
  1702.   ELSE
  1703.     DO
  1704.       SAY 'Select Message Conference By Number, ['pen3'M'def']arked only or ['pen3'A'def']ll Active'CR
  1705.       IF areaselect() THEN
  1706.         DO
  1707.           IF LEFT(temp,1)='A' THEN CALL newmsgs()
  1708.           IF LEFT(temp,1)='M' THEN CALL readmarked()
  1709.           RETURN
  1710.         END
  1711.     END
  1712.   pline='['pen3'A'def']rchive ['pen3'S'def']earch ['pen3'T'def']oggle ON/OFF'
  1713.   pline=pline '['pen3'R'def']ead ['pen3'Q'def']uit (aqRst) > '
  1714.   IF arg~='' THEN junk=UPPER(LEFT(arg,1))
  1715.   ELSE junk=getinput(1 1 pline)
  1716.   IF junk='Q' THEN RETURN
  1717.   IF junk='A' THEN
  1718.     DO
  1719.       SAY CR
  1720.       CALL msgcount(msgdir)
  1721.       junk=getinput(1 0 pen3'RETURN'def' to archive new msgs, ['pen3'Q'def']uit, or enter starting message number > ')
  1722.       IF junk='Q' THEN RETURN
  1723.       IF DATATYPE(junk,'N') THEN
  1724.         DO
  1725.           IF junk>lastmess | junk<1 THEN junk=1
  1726.           lastread.msgdir=junk-1
  1727.           CALL savedata(1)
  1728.         END
  1729.       CALL SETCLIP('BBS_MSGS','ON')
  1730.       SAY 'Archiving messages in the'pen3 msg.msgdir def'Conference...'CR
  1731.       lastread.msgdir=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  1732.       CALL send2log('Arc: ArcMsgs.rexx' msg.msgdir)
  1733.       ADDRESS AREXX ArcMsgs.rexx name msgdir
  1734.       IF emailonline>=0 THEN emailonline=emailonline+1
  1735.       DO WHILE GETCLIP('BBS_MSGS')~=''
  1736.         CALL DELAY(14)
  1737.       END
  1738.       SAY 'When completed, the archive will be attached to email addressed to you.'CR
  1739.       CALL savedata(1)
  1740.       SAY CR
  1741.       RETURN
  1742.     END
  1743.   IF junk='S' THEN
  1744.     DO
  1745.       searcharg=''
  1746.       searcharg=getinput(0 0 pen3'Search Phrase: 'def)
  1747.       IF LENGTH(STRIP(searcharg))=0 THEN RETURN
  1748.       searcharg=COMPRESS(searcharg,'*')
  1749.       CALL searchmsgdir()
  1750.       searcharg=''
  1751.       RETURN
  1752.     END
  1753.   IF junk='T' THEN
  1754.     DO
  1755.       line='Turning the' msg.msgdir 'conference'
  1756.       IF WORD(data.22,msgdir)<0 THEN
  1757.         DO
  1758.           line=line pen3'ON'def'.'
  1759.           newdata='0'
  1760.         END
  1761.       ELSE
  1762.         DO
  1763.           line=line pen3'OFF'def'.'
  1764.           newdata='-1'
  1765.         END
  1766.       SAY line||CR
  1767.       dataloc=WORDINDEX(data.22,msgdir)-1
  1768.       data.22=DELWORD(data.22,msgdir,1)
  1769.       IF dataloc>0 THEN data.22=INSERT(newdata' ',data.22,dataloc)
  1770.       CALL sortconferences()
  1771.     END
  1772.   CALL readmsg(0)
  1773.   CALL saveData(1)
  1774.   nonstop=0
  1775.   arg=''
  1776. END
  1777. RETURN
  1778.  
  1779.  
  1780. newmsgs:
  1781. test=UPPER(LEFT(arg,1))
  1782. IF test='' THEN
  1783.   test=getinput(1 1 '['pen3'R'def']ead new messages or ['pen3'A'def']rchive for later download. (aR) > ')
  1784. IF test='A' THEN
  1785.   DO
  1786.     CALL SETCLIP('BBS_MSGS','ON')
  1787.     SAY CR
  1788.     SAY 'Archiving new conference messages...'CR
  1789.     CALL send2log('Arc: ArcMsgs.rexx')
  1790.     ADDRESS AREXX ArcMsgs.rexx name
  1791.     IF emailonline>=0 THEN emailonline=emailonline+1
  1792.     clear_marked=1
  1793.     DO i=1 TO level
  1794.       IF WORD(data.22,i)~=-1 THEN
  1795.         lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
  1796.     END
  1797.     DO WHILE GETCLIP('BBS_MSGS')~=''
  1798.       CALL DELAY(14)
  1799.     END
  1800.     SAY 'When completed, the archive will be attached to email addressed to you.'CR
  1801.     CALL savedata(1)
  1802.     SAY CR
  1803.     RETURN
  1804.   END
  1805. curmsgdir=msgdir
  1806. SAY 'Scanning all Conferences for new messages..'CR
  1807. DO newi=1 TO level
  1808.   IF msg.newi='' THEN ITERATE newi
  1809.   msgdir=newi
  1810.   CALL readmsg(1)
  1811.   IF msgcom='Q' THEN LEAVE newi
  1812. END
  1813. CALL saveData(1)
  1814. msgdir=curmsgdir
  1815. nonstop=0
  1816. RETURN
  1817.  
  1818.  
  1819. readmsg:
  1820. ARG quietflag marknum .
  1821. msgcom=''
  1822. IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */
  1823. IF WORD(data.22,msgdir)=-1 THEN RETURN;                /* user  excluded */
  1824. entering='Entering'pen3 msg.msgdir def'Message Conference..'
  1825. IF quietflag=0 & marknum='' THEN SAY entering||CR
  1826. CALL postuser(2)
  1827. IF DATATYPE(WORD(data.22,msgdir),'N') THEN
  1828.   lastread.msgdir=WORD(data.22,msgdir)
  1829. ELSE lastread.msgdir=0
  1830. lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  1831. frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0)
  1832. temp=''
  1833. IF marknum='' THEN
  1834.   DO
  1835.     IF lastread.msgdir>=lstwrt | lastread.msgdir<frstwrt THEN
  1836.       DO
  1837.         lastread.msgdir=lstwrt
  1838.         CALL msgcount(msgdir)
  1839.         IF quietflag=1 & lastread.msgdir=lstwrt THEN RETURN
  1840.         IF nonstop=1 THEN temp=''
  1841.         ELSE temp=getinput(1 0 pen3'Enter starting message number > 'def)
  1842.         IF temp='' THEN temp=lastread.msgdir
  1843.         IF ~DATATYPE(temp,'N') THEN RETURN
  1844.         IF temp<frstwrt THEN temp=frstwrt
  1845.         IF temp>lstwrt THEN temp=lstwrt
  1846.         IF temp<1 THEN temp=1
  1847.         lastread.msgdir=temp-1
  1848.       END
  1849.   END
  1850. ELSE lastread.msgdir=marknum-1
  1851. IF quietflag=1 THEN SAY entering||CR
  1852. dirname=msgpath||msgdir
  1853. msglist.=0 /* set read to 0, unread to 1, and reply >=2 */
  1854. firstmess=999999
  1855. testlist=SHOWDIR(dirname)
  1856. DO i=1 TO WORDS(testlist)
  1857.   test=WORD(testlist,i)
  1858.   IF test>lastread.msgdir THEN msglist.test=1
  1859.   IF test<firstmess THEN firstmess=test
  1860. END
  1861. IF firstmess=999999 THEN firstmess=0
  1862. CALL countcheck(bbspath'Numbers/FirstMessage'msgdir firstmess)
  1863. msgstatus=1
  1864. IF temp='' & marknum='' THEN CALL msgcount(msgdir)
  1865. skipsubj.=''
  1866. skipsubj.0=0
  1867. DO msgloop=1
  1868.   lastreadnum=lastread.msgdir
  1869.   DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
  1870.     lastreadnum=lastreadnum+1
  1871.   END
  1872.   lastread.msgdir=lastreadnum
  1873.   IF lastreadnum=lstwrt & msglist.lstwrt=0 THEN LEAVE msgloop
  1874.   DO mess=lastread.msgdir TO lstwrt+1
  1875.     IF marknum~='' THEN
  1876.       DO
  1877.         IF mess>marknum THEN LEAVE msgloop
  1878.         mess=marknum
  1879.       END
  1880.     IF msglist.mess~=msgstatus THEN ITERATE mess
  1881.     IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'CR
  1882.     msglist.mess=0
  1883.     arg=dirname'/'mess
  1884.     IF ~EXISTS(arg) THEN
  1885.       DO
  1886.         SAY 'Message number' mess 'is missing.'CR
  1887.         ITERATE mess
  1888.       END
  1889.     IF ~readopen(arg) THEN ITERATE mess
  1890.     firstline=READLN(f)
  1891.     secondline=READLN(f)
  1892.     thirdline=READLN(f)
  1893.     forthline=READLN(f)
  1894.     CALL CLOSE(f)
  1895.     CALL killmark(msgdir mess)
  1896.     DO skp=1 TO skipsubj.0
  1897.       IF forthline=skipsubj.skp THEN ITERATE mess
  1898.     END
  1899.     IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */
  1900.       DO
  1901.         thread=SUBSTR(firstline,WORDINDEX(firstline,4))
  1902.         DO tindx=1 TO WORDS(thread)
  1903.           test=WORD(thread,tindx)
  1904.           IF msglist.test~=0 THEN msglist.test=msgstatus+1
  1905.         END
  1906.       END
  1907.     savearg=arg
  1908.     msgcom='A'
  1909.     DO msgloop2=1 WHILE msgcom='A' | msgcom='O'
  1910.       CALL readlines(arg 1)
  1911.       IF nonstop=1 THEN rnonstop=1
  1912.       ELSE rnonstop=0
  1913.       CALL seelines(2)
  1914.       msgcom=''
  1915.       IF rnonstop THEN
  1916.         DO
  1917.           SAY CR
  1918.           nonstop=1
  1919.           msgcom=''
  1920.         END
  1921.       ELSE
  1922.         DO
  1923.           pline=''
  1924.           IF level<=sysoplevel | WORDS(lynes.3)<3 THEN pline='['pen3'A'def']gain'
  1925.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  1926.             pline=pline '['pen3'E'def']dit ['pen3'K'def']ill'
  1927.           IF level>sysoplevel THEN pline=pline '['pen3'M'def']ove'
  1928.           IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal'
  1929.           pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply'
  1930.           IF level=99 THEN pline=pline '['pen3'!'def']'
  1931.           pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit ['pen3'?'def']'
  1932.           msgcom=getinput(1 0 STRIP(pline)' > ')
  1933.           CALL cleanline(0)
  1934.         END
  1935.       CALL checktime()
  1936.       IF DATATYPE(msgcom,'N') & EXISTS(dirname'/'msgcom) THEN
  1937.         DO
  1938.           arg=dirname'/'msgcom
  1939.           IF msgcom>lastread.msgdir THEN lastread.msgdir=msgcom
  1940.           msgcom='A'
  1941.           ITERATE msgloop2
  1942.         END
  1943.       ELSE msgcom=LEFT(msgcom,1)
  1944.       IF msgcom='Q' THEN LEAVE msgloop
  1945.       ELSE IF msgcom='!' & level>sysoplevel THEN
  1946.         DO
  1947.           CALL DELETE(arg)
  1948.           newchar=LEFT(lynes.1,1)
  1949.           IF newchar~='!' THEN newchar='!!'
  1950.           ELSE newchar='  '
  1951.           lynes.1=OVERLAY(newchar,lynes.1,1,2)
  1952.           CALL savelines(arg)
  1953.           ITERATE msgloop2
  1954.         END
  1955.       ELSE IF msgcom='A' THEN ITERATE msgloop2
  1956.       ELSE IF msgcom='M' & level>sysoplevel THEN
  1957.         DO
  1958.           prevmsgdir=msgdir
  1959.           If areaselect()=0 THEN
  1960.             DO
  1961.               himsg=countcheck(bbspath'Numbers/LastMessage'msgdir 0)+1
  1962.               lynes.1='  Msg:' himsg
  1963.               lynes.3='   To:' WORD(lynes.3,2)
  1964.               lynes.5=STRIP(DELWORD(lynes.5,8,1)) msg.msgdir
  1965.               nlyn=lynes.0+1
  1966.               lynes.0=nlyn
  1967.               lynes.nlyn=' *** Moved from the' msg.prevmsgdir 'conference ***'
  1968.               CALL savelines(msgpath||msgdir'/'himsg)
  1969.               CALL countcheck(bbspath'Numbers/LastMessage'msgdir himsg)
  1970.               CALL msgmark(WORD(lynes.3,2) msgdir himsg)
  1971.               CALL readlines(arg 1)
  1972.               CALL DELETE(arg)
  1973.               CALL DELAY(28)
  1974.               lynes.0=7
  1975.               lynes.7='*** Moved to the' msg.msgdir 'conference, message #'himsg' ***'
  1976.               CALL savelines(arg)
  1977.             END
  1978.           msgdir=prevmsgdir
  1979.           msgcom='A'
  1980.         END
  1981.       ELSE IF msgcom='N' THEN
  1982.         DO
  1983.           nonstop=1
  1984.           msgcom=''
  1985.         END
  1986.       ELSE IF msgcom='H' | msgcom='?' THEN
  1987.         DO
  1988.           SAY pen3' - HELP with the Read Messages commands -'def||CR
  1989.           SAY ' RETURN reads the next message in line.'CR
  1990.           SAY ' 34 will read message number 34, if it exists in this conference.'CR
  1991.           SAY ' A  reads this message Again (in case it scrolled off screen).'CR
  1992.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  1993.             DO
  1994.           SAY ' E  puts this message into the online Editor.'CR
  1995.           SAY ' K  deletes a message you wrote. you cannot Kill others!'CR
  1996.             END
  1997.           IF level>sysoplevel THEN
  1998.           SAY ' M  move this message to a new conference.'CR
  1999.           SAY ' N  displays all new messages without pausing. CTRL-E to Exit!'CR
  2000.           SAY ' O  if this message is a reply, will read the Original message.'CR
  2001.           SAY ' R  enters the message editor to Reply to this message.'CR
  2002.           SAY ' S  allows you to Skip threads or conferences.'CR
  2003.         IF level=99 THEN
  2004.           SAY ' !  toggles the do-not-purge! flag for this message.'CR
  2005.           SAY ' Q  returns to the message menu. (Quit)'CR
  2006.           SAY CR
  2007.           CALL waiting()
  2008.           msgcom='A'
  2009.           IF waitchar='Q' THEN LEAVE msgloop
  2010.         END
  2011.       ELSE IF msgcom='E' THEN
  2012.         DO
  2013.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  2014.             DO
  2015.               sline=7
  2016.               IF level>sysoplevel THEN sline=1
  2017.               CALL bbsED(sline arg)
  2018.               msgcom='A'
  2019.             END
  2020.         END
  2021.       ELSE IF msgcom='S' & mess<lstwrt THEN
  2022.         DO
  2023.           stemp=''
  2024.           DO WHILE stemp~='T' & stemp~='C'
  2025.             stemp=getinput(1 1 'Skip this ['pen3'T'def']hread or the entire ['pen3'C'def']onference (ct) > ')
  2026.           END
  2027.           IF stemp='T' THEN
  2028.             DO
  2029.               SAY CR
  2030.               SAY pen3 forthline||def||CR
  2031.               SAY 'Skipping messages with this subject heading...'CR
  2032.               SAY CR
  2033.               DO i=lastread.msgdir TO lstwrt
  2034.                 IF msglist.i>1 THEN msglist.i=0
  2035.               END
  2036.               skipsubj.0=skipsubj.0+1
  2037.               sksb=skipsubj.0
  2038.               skipsubj.sksb=forthline
  2039.             END
  2040.           ELSE
  2041.             DO
  2042.               SAY pen3'Skipping to the last message in the'def msg.msgdir pen3'conference.'def||CR
  2043.               lastread.msgdir=lstwrt-1
  2044.               lw=lstwrt-1
  2045.               msglist.lw=0
  2046.               msglist.lstwrt=1
  2047.               LEAVE mess
  2048.             END
  2049.         END
  2050.       ELSE IF msgcom='K' THEN
  2051.         DO
  2052.           IF level>sysoplevel | name=WORD(lynes.2,2) THEN
  2053.             DO
  2054.               IF getinput(1 1 'Really delete' arg'? (Ny) > ')='Y' THEN
  2055.                 DO
  2056.                   IF DELETE(arg)=1 THEN
  2057.                     SAY pen3||arg||def' has been deleted.'CR
  2058.                   grand=grand-1
  2059.                   msg.msgdir.0=msg.msgdir.0-1
  2060.                 END
  2061.             END
  2062.         END
  2063.       ELSE IF msgcom='O' THEN   /* go back and read original */
  2064.         DO
  2065.           IF WORDS(lynes.3)>3 THEN
  2066.             DO
  2067.               temp=WORD(lynes.3,4)
  2068.               arg=dirname'/'temp
  2069.             END
  2070.           ELSE SAY 'This is the original message.'CR
  2071.         END
  2072.       ELSE IF msgcom='R' THEN        /*  toname     msgnum  */
  2073.         DO
  2074.           msgnum=WORD(lynes.1,2)
  2075.           forthline=lynes.4
  2076.           IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */
  2077.             DO
  2078.               savearg2=arg
  2079.               arg=dirname'/'WORD(lynes.3,4)
  2080.               IF EXISTS(arg) THEN
  2081.                 DO
  2082.                   IF readlines(arg 1) THEN BREAK
  2083.                   xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mess)
  2084.                   IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg
  2085.                   ELSE lynes.1=lynes.1'   Reply' xmsg
  2086.                   CALL DELAY(28)    /* allow 1/2 sec for read to close */
  2087.                   CALL savelines(arg)
  2088.                 END
  2089.               arg=savearg2
  2090.             END
  2091.         END
  2092.       ELSE IF arg~=savearg THEN    /* Continue */
  2093.         DO
  2094.           msgcom='A'
  2095.           arg=savearg
  2096.         END
  2097.     END
  2098.     IF thread~='' THEN
  2099.       DO
  2100.         thread=''
  2101.         msgstatus=msgstatus+1
  2102.       END
  2103.   END
  2104.   IF msgstatus>1 THEN msgstatus=msgstatus-1
  2105. END
  2106. DROP msglist. skipsubj.
  2107. IF quietflag~=1 THEN nonstop=0
  2108. RETURN
  2109.  
  2110.  
  2111. showmarked:
  2112. IF WORDS(data.24)<1 THEN RETURN
  2113. SAY CR
  2114. SAY pen6'These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'def||CR
  2115. tempkk=data.24
  2116. DO i=1 TO WORDS(tempkk)
  2117.   tempk=WORD(tempkk,i)
  2118.   PARSE VAR tempk kdir'/'kmsg
  2119.   IF EXISTS(msgpath||kdir'/'kmsg) THEN
  2120.     SAY RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference.'CR
  2121.   ELSE data.24=DELWORD(data24,FIND(data.24,tempk))
  2122. END
  2123. CALL waiting()
  2124. SAY CR
  2125. RETURN
  2126.  
  2127.  
  2128. killmark:
  2129. PARSE ARG kdir kmsg .
  2130. IF data.24='' THEN RETURN
  2131. markword=FIND(data.24,kdir'/'kmsg)
  2132. IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1))
  2133. RETURN
  2134.  
  2135.  
  2136. readmarked:
  2137. mrknum=WORDS(data.24)
  2138. IF mrknum=0 THEN RETURN
  2139. SAY 'Reading only messages addressed to you...'CR
  2140. mrklist=data.24
  2141. msgcom=''
  2142. DO rmki=1 TO mrknum WHILE msgcom~='Q'
  2143.   tempk=WORD(mrklist,rmki)
  2144.   PARSE VAR tempk mkdir'/'mkmsg .
  2145.   IF ~EXISTS(msgpath||tempk) THEN
  2146.     DO
  2147.       CALL killmark(mkdir mkmsg)
  2148.       SAY CR
  2149.       SAY 'Message number' mkmsg 'in the' msg.mkdir 'conference is missing!'CR
  2150.       SAY CR
  2151.       ITERATE rmki
  2152.     END
  2153.   msgdir=mkdir
  2154.   savelast=lastread.msgdir
  2155.   CALL readmsg(1 mkmsg)
  2156.   IF mkmsg>savelast THEN lastread.msgdir=mkmsg
  2157.   ELSE lastread.msgdir=savelast
  2158. END
  2159. CALL saveData(1)
  2160. RETURN
  2161.  
  2162.  
  2163. sortnumbers:
  2164. PARSE ARG slist
  2165. IF STRIP(slist)='' THEN RETURN ''
  2166. sorted.=''
  2167. oldest=999999
  2168. newest=0
  2169. newlist=''
  2170. DO si=1 TO WORDS(slist)
  2171.   testword=WORD(slist,si)
  2172.   IF ~DATATYPE(testword,'N') THEN
  2173.     DO
  2174.       testpos=LASTPOS('.',testword)
  2175.       IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1)
  2176.       ELSE
  2177.         DO
  2178.           newlist=testword newlist
  2179.           ITERATE si
  2180.         END
  2181.     END
  2182.   ELSE tempnum=testword/1
  2183.   IF sorted.tempnum='' THEN
  2184.     DO
  2185.       sorted.tempnum=testword
  2186.       sorted.tempnum.0=1
  2187.       IF DATATYPE(tempnum,'N') THEN
  2188.         DO
  2189.           IF tempnum>newest THEN newest=tempnum
  2190.           IF tempnum<oldest THEN oldest=tempnum
  2191.         END
  2192.     END
  2193.   ELSE newlist=newlist testword
  2194. END
  2195. IF oldest~=999999 & newest~=0 THEN
  2196.   DO si=oldest TO newest
  2197.     IF sorted.si.0=1 THEN newlist=newlist sorted.si
  2198.   END
  2199. DROP sorted. oldest newest
  2200. RETURN STRIP(newlist)
  2201.  
  2202.  
  2203. readmail:
  2204. ARG fromenu .
  2205. CALL postuser(3)
  2206. replysubj=''
  2207. IF fromenu THEN
  2208.   DO
  2209.     temp=UPPER(arg)
  2210.     arg=''
  2211.     IF temp~='F' & temp~='T' & temp~='W' THEN
  2212.       DO
  2213.         line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email (ftw) > 'def
  2214.         temp=getinput(1 1 line)
  2215.         CALL cleanline(0)
  2216.       END
  2217.     IF temp='W' THEN
  2218.       DO
  2219.         CALL editor('MAIL')
  2220.         RETURN
  2221.       END
  2222.     ELSE IF temp='F' THEN
  2223.       DO
  2224.         SAY pen3'Scanning'def WORDS(userlist) pen3'email directories...'def||CR
  2225.         firsteditline=0
  2226.         picklist.=''
  2227.         picklist.0=0
  2228.         DO ei=1 TO WORDS(userlist)
  2229.           fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,ei))
  2230.           DO ej=1 TO WORDS(fmaillist)
  2231.             ejname=WORD(fmaillist,ej)
  2232.             uname=ejname
  2233.             caret=LASTPOS('.',uname)
  2234.             IF caret>2 THEN uname=LEFT(uname,caret-1)
  2235.             IF uname=name THEN
  2236.               DO
  2237.                 arg=bbspath'EMail/'WORD(userlist,ei)'/'ejname
  2238.                 IF EXISTS(arg) THEN
  2239.                   DO
  2240.                     pklst=picklist.0+1
  2241.                     picklist.pklst=WORD(userlist,ei)
  2242.                     picklist.pklst.0=ejname
  2243.                     picklist.0=pklst
  2244.                   END
  2245.               END
  2246.           END
  2247.         END
  2248.         IF picklist.0=0 THEN SAY lineup'No Email FROM you was found.                    'CR
  2249.         ELSE
  2250.           DO
  2251.             SAY pen3'You have Email pending to the following users:'def||CR
  2252.             pickcheck=1
  2253.             DO WHILE pickcheck~=0
  2254.               pickcheck=pickfromlist()
  2255.               IF pickcheck~=0 THEN
  2256.                 DO
  2257.                   firsteditline=5
  2258.                   IF level>sysoplevel THEN firsteditline=1
  2259.                   CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
  2260.                   IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
  2261.                     picklist.pickcheck='- KILLED -'
  2262.                 END
  2263.             END
  2264.           END
  2265.         DROP picklist.
  2266.         RETURN
  2267.       END
  2268.     ELSE IF temp='T' THEN BREAK
  2269.     ELSE RETURN
  2270.   END
  2271. SAY 'Checking your mailbox..'CR
  2272. nomail=1
  2273. CALL MAKEDIR(bbspath'EMail/'name)
  2274. mailist=sortnumbers(SHOWDIR(bbspath'Email/'name))
  2275. IF WORDS(mailist)>0 THEN
  2276.   DO
  2277.     line=WORDS(mailist)
  2278.     IF line>1 THEN line=line 'letters'
  2279.     ELSE line=line 'letter'
  2280.     line=line 'waiting.'
  2281.     SAY line||CR
  2282.     DO ii=1 TO WORDS(mailist)
  2283.       SAY 'Email:' pen3||WORD(mailist,ii)||def||CR
  2284.     END
  2285.     IF ~fromenu THEN
  2286.       IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN
  2287.   END
  2288. DO letter=1 TO WORDS(mailist)
  2289.   readname=WORD(mailist,letter)
  2290.   uname=readname
  2291.   caret=LASTPOS('.',uname)
  2292.   IF caret>2 THEN uname=LEFT(uname,caret-1)
  2293.   arg=bbspath'Email/'name'/'readname        /* user has mail! */
  2294.   CALL readlines(arg 1)
  2295.   CALL seelines(1)
  2296.   nomail=0
  2297.   nonstop=0
  2298.   mailfile=''
  2299.   IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4)
  2300.   ELSE IF UPPER(WORD(lynes.2,3))='FILE:' THEN mailfile=WORD(lynes.2,4)
  2301.   IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN
  2302.     DO
  2303.       curdir=PRAGMA('D')
  2304.       CALL setdir(bbspath'EmailFiles/'name)
  2305.       filesize=WORD(STATEF(mailfile),2)
  2306.       IF getinput(1 1 ' Attached file:' pen3||mailfile||def 'is' pen3||filesize||def 'bytes.  Download now? (nY) > ')~='N' THEN
  2307.         DO
  2308.           savearg=arg
  2309.           arg=mailfile
  2310.           DO WHILE dload()=1
  2311.           END
  2312.           arg=savearg
  2313.         END
  2314.       CALL setdir(curdir)
  2315.     END
  2316.   IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN
  2317.     DO
  2318.       IF getinput(1 1 'Reply to this message? (nY) > ')~='N' THEN
  2319.         DO
  2320.           IF WORDS(lynes.4)<2 THEN replysubj='NONE'
  2321.           ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
  2322.           CALL editor('MAIL' uname)
  2323.           replysubj=''
  2324.         END
  2325.     END
  2326.   IF LEFT(readname,6)~='BBBBS.' THEN
  2327.     DO
  2328.       IF getinput(1 1 'Forward mail from'pen3 uname def'to other users? (Ny) > ')='Y' THEN
  2329.         DO
  2330.           IF selectchosen(1 pen3'Forward Email To: 'def)=0 THEN
  2331.             DO ei=1 TO thechosen.0 WHILE thechosen.ei~=''
  2332.               CALL MAKEDIR(bbspath'EMail/'thechosen.ei)
  2333.               forwardarg=bbspath'Email/'thechosen.ei'/'readname
  2334.               ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg
  2335.               CALL readlines(forwardarg 1)
  2336.               lynes.1=lynes.1'  Forwarded to you by' name TIME('C') DATE()
  2337.               CALL DELETE(forwardarg)
  2338.               CALL savelines(forwardarg)
  2339.               IF WORDS(lynes.2)>3 THEN
  2340.                 DO
  2341.                   forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
  2342.                   IF EXISTS(forname) THEN
  2343.                     DO
  2344.                       CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei)
  2345.                       ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'thechosen.ei
  2346.                     END
  2347.                 END
  2348.               line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def
  2349.               IF emailonline>=0 THEN emailonline=emailonline+1
  2350.               CALL send2log(line)
  2351.               SAY line||CR
  2352.             END
  2353.         END
  2354.     END
  2355.   tempchar=getinput(1 1 'Delete the mail from'pen3 uname def'you just read? (nqY) > 'def)
  2356.   IF tempchar='Q' THEN
  2357.     IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN RETURN
  2358.   IF tempchar~='N' THEN
  2359.     DO
  2360.       dirname=bbspath'Email/'name'/'
  2361.       nodelete=0
  2362.       IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN
  2363.         nodelete=1
  2364.       IF nodelete THEN
  2365.         ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop
  2366.       ELSE emailonline=emailonline-1
  2367.       CALL DELETE(dirname||readname)
  2368.       tempstr='Old email'
  2369.       IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
  2370.         DO
  2371.           IF nodelete THEN
  2372.             ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop
  2373.           CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
  2374.           tempstr=tempstr 'and attached file'
  2375.         END
  2376.       tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
  2377.       SAY tempstr||CR
  2378.       IF tempchar='Q' THEN
  2379.         IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN RETURN
  2380.     END
  2381.   ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN
  2382.     DO
  2383.       ii=LEFT(readname,POS('.',readname)-1)
  2384.       ii=SUBSTR(ii,4)%1
  2385.       IF getinput(1 1 'Move this message back to the' msg.ii 'conference? (nY) > 'def)~='N' THEN
  2386.         DO
  2387.           temp=TRANSLATE(readname,'/','.')
  2388.           temp=SUBSTR(temp,4)
  2389.           lynes.1='!!'STRIP(lynes.1)
  2390.           edtype=''
  2391.           CALL savelines(msgpath||temp)
  2392.           CALL DELETE(bbspath'Email/'name'/'readname)
  2393.         END
  2394.     END
  2395.   ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN
  2396.     DO
  2397.       arg=bbspath'Email/'name'/'readname
  2398.       CALL readlines(arg 1)
  2399.       IF WORDS(lynes.5)<7 THEN
  2400.         DO
  2401.           lynes.5=lynes.5'  (Rcvd)' DATE('W') DATE() TIME('C')
  2402.           CALL DELETE(arg)
  2403.           CALL savelines(arg)
  2404.           SAY 'Email has been marked as received.'CR
  2405.         END
  2406.     END
  2407.   CALL checktime()
  2408.   readname=''
  2409.   uname=''
  2410.   arg=''
  2411. END
  2412. IF nomail THEN
  2413.   DO
  2414.     SAY 'No mail was found.'CR
  2415.     CALL waiting()
  2416.   END
  2417. CALL setdir(libpath||dirs.1)
  2418. thechosen.=''
  2419. RETURN
  2420.  
  2421.  
  2422. selectchosen:
  2423. PARSE ARG startat selectline
  2424. IF startat<2 THEN thechosen.=''
  2425. line='Enter list of comma separated user names'
  2426. IF level>sysoplevel THEN line=line 'or ALL'
  2427. SAY line||CR
  2428. thechosen.startat=getinput(1 0 selectline' ')
  2429. IF STRIP(thechosen.startat)='' THEN RETURN 1
  2430. thechosen.startat=SPACE(thechosen.startat,1,'_')
  2431. thechosen.0=startat
  2432. IF level>sysoplevel & thechosen.startat='ALL' THEN
  2433.   thechosen.startat=SHOWDIR(bbspath'Users','F',',')
  2434. IF POS(',',thechosen.startat)>0 THEN
  2435.   DO
  2436.     temp=TRANSLATE(thechosen.startat,' ',',')
  2437.     thechosen.0=thechosen.0+WORDS(temp)-1
  2438.     DO ei=1 TO WORDS(temp)
  2439.       eii=startat+ei-1
  2440.       thechosen.eii=STRIP(WORD(temp,ei))
  2441.     END
  2442.   END
  2443. DO ei=startat TO thechosen.0
  2444.   DO WHILE FIND(userlist,thechosen.ei)=0
  2445.     IF thechosen.ei~='' THEN
  2446.       DO
  2447.         IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
  2448.           DO
  2449.             thechosen.ei=sysop
  2450.             ITERATE ei
  2451.           END
  2452.         CALL loadcourtesy()
  2453.         IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
  2454.       END
  2455.     SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR
  2456.     thechosen.ei=getinput(1 0 pen3||selectline' 'def)
  2457.     IF thechosen.ei='' THEN
  2458.       DO
  2459.         IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
  2460.           CALL showuserlist()
  2461.         ITERATE ei
  2462.       END
  2463.     thechosen.ei=SPACE(thechosen.ei,1,'_')
  2464.   END
  2465. END
  2466. RETURN 0
  2467.  
  2468.  
  2469. countcheck:
  2470. PARSE ARG fname' 'cknum' '.
  2471. IF ~EXISTS(fname) THEN
  2472.   DO
  2473.     IF cknum=0 THEN RETURN 0
  2474.     IF ~writeopen(fname) THEN RETURN 0
  2475.     CALL WRITELN(f,cknum)
  2476.     CALL CLOSE(f)
  2477.     RETURN cknum
  2478.   END
  2479. IF ~readopen(fname) THEN RETURN cknum
  2480. retval=STRIP(READLN(f))
  2481. CALL CLOSE(f)
  2482. IF ~DATATYPE(retval,'N') THEN retval=0
  2483. IF ~DATATYPE(cknum,'N') THEN cknum=0
  2484. IF retval<cknum THEN
  2485.   DO
  2486.     IF writeopen(fname) THEN
  2487.       DO
  2488.         CALL WRITELN(f,cknum)
  2489.         CALL CLOSE(f)
  2490.         RETURN cknum
  2491.       END
  2492.   END
  2493. RETURN retval
  2494.  
  2495.  
  2496. pickfromlist:
  2497. DO pfl=1 TO picklist.0 BY 3
  2498.   pfl2=pfl+1
  2499.   pfl3=pfl+2
  2500.   pfline=pen3||RIGHT(pfl,3)||def LEFT(picklist.pfl,21)
  2501.   IF picklist.pfl2~='' THEN
  2502.     pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(picklist.pfl2,21)
  2503.   IF picklist.pfl3~='' THEN
  2504.     pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(picklist.pfl3,21)
  2505.   SAY pfline||CR
  2506. END
  2507. emnum=getinput(1 0 pen3'Select Email Number > 'def)
  2508. IF ~DATATYPE(emnum,'N') | emnum<1 | emnum>picklist.0 THEN RETURN 0
  2509. RETURN emnum
  2510.  
  2511.  
  2512. sysED:
  2513. IF level<99 THEN RETURN
  2514. arg=getinput(0 0 'Textfile To Edit: ')
  2515. IF arg='' THEN RETURN
  2516. CALL bbsED(1 arg)
  2517. RETURN
  2518.  
  2519.  
  2520. bbsED:
  2521. PARSE ARG firstedit editarg .
  2522. notchanged=1
  2523. IF readlines(editarg 1) THEN RETURN 1
  2524. finfo=STATEF(editarg)
  2525. IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
  2526. ELSE finfo=''
  2527. SAY CR
  2528. SAY '                   'pen3'Entering the EDITOR module..'def||CR
  2529. SAY CR
  2530. count=1
  2531. DO edloop=1
  2532.   IF edcom='S' & bbsprefs.5 THEN  /* spell check */
  2533.     DO
  2534.       SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def||CR
  2535.       CALL DELETE(scratch'/SpellFile')
  2536.       CALL savelines(scratch'/SpellFile')
  2537.       curdir=PRAGMA('D')
  2538.       CALL setdir(spellpath)
  2539.       CALL SpellChk.rexx(scratch'/SpellFile')
  2540.       CALL setdir(curdir)
  2541.     END
  2542.   ELSE
  2543.     DO
  2544.       IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
  2545.       IF edcom~='L' THEN count=count-linesperpage
  2546.       IF count>=lynes.0 | count<1 THEN count=1
  2547.       startcount=count
  2548.       DO i=startcount TO lynes.0+1
  2549.         IF ((i+1-startcount)//linesperpage)=0 THEN
  2550.           DO
  2551.             pline='                 ['pen3'E'def']dit'
  2552.             pline=pline '  ['pen3'RETURN'def']=Continue '
  2553.             edcom=getinput(1 1 pline)
  2554.             IF edcom~='' THEN LEAVE i
  2555.             CALL cleanline(1)
  2556.           END
  2557.         SAY pen3||RIGHT(i,3)||def lynes.i||CR
  2558.         count=count+1
  2559.       END
  2560.     END
  2561.   CALL checktime()
  2562.   SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'CR
  2563.   pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  2564.   IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  2565.   pline=pline '['pen3'U'def']pload-Text > '
  2566.   edcom=getinput(1 0 pline)
  2567.   IF edcom='Q' | edcom='X' THEN edcom=''
  2568.   IF edcom='?' THEN
  2569.     DO
  2570.       SAY CR
  2571.       SAY '                   Editor Help'CR
  2572.       SAY '-------------------------------------------------------'CR
  2573.       SAY ' 7  edits line number 7, if it exists.'CR
  2574.       SAY ' a  Append text to this file.'CR
  2575.       SAY ' c  Cut selected line(s) of text to buffer.'CR
  2576.       SAY ' i  Insert blank line.'CR
  2577.       SAY ' k  Kill (delete) this file.'CR
  2578.       SAY ' l  List this file from selected line.'CR
  2579.       SAY ' p  Paste buffer contents to selected line number.'CR
  2580.       SAY ' r  Replace a phrase or line of text.'CR
  2581.       SAY ' s  Spellcheck this file.'CR
  2582.       SAY ' u  Upload a texfile to append to this file.'CR
  2583.       SAY '    An empty RETURN indicates you are finished editing.'CR
  2584.       SAY '-------------------------------------------------------'CR
  2585.       SAY CR
  2586.       OPTIONS PROMPT ''
  2587.       PULL
  2588.     END
  2589.   IF edcom='K' THEN
  2590.     DO
  2591.       junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
  2592.       IF junk='Y' THEN
  2593.         DO
  2594.           IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'CR
  2595.           IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
  2596.             DO
  2597.               IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
  2598.                 SAY WORD(lynes.2,4) 'DELETED.'CR
  2599.             END
  2600.           RETURN 2
  2601.         END
  2602.     END
  2603.   IF edcom='' THEN
  2604.     DO
  2605.       SAY '                   'pen3'Leaving the EDITOR module.'def||CR
  2606.       IF notchanged THEN RETURN 0
  2607.       IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
  2608.         RETURN 1
  2609.       CALL DELETE(editarg)
  2610.       IF savelines(editarg) THEN RETURN 1
  2611.       CALL DELAY(28)
  2612.       IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
  2613.       SAY pen3'                        Changes saved.'def||CR
  2614.       RETURN 0
  2615.     END
  2616.   ELSE IF edcom='C' THEN  /* Cut */
  2617.     DO
  2618.       firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
  2619.       IF firstnum='' THEN ITERATE edloop
  2620.       dash=POS('-',firstnum)
  2621.       IF dash>0 THEN
  2622.         DO
  2623.           lastnum=STRIP(SUBSTR(firstnum,dash+1))
  2624.           firstnum=STRIP(LEFT(firstnum,dash-1))
  2625.         END
  2626.       ELSE lastnum=firstnum
  2627.       IF ~DATATYPE(firstnum,'N') | ~DATATYPE(lastnum,'N') THEN
  2628.         DO
  2629.           junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
  2630.           ITERATE edloop
  2631.         END
  2632.       IF lastnum>lynes.0 THEN lastnum=lynes.0
  2633.       IF firstnum<firstedit THEN
  2634.         DO
  2635.           SAY '*** You are not authorized to delete that line!'CR
  2636.           SAY CR
  2637.           ITERATE edloop
  2638.         END
  2639.       IF firstnum>lastnum THEN
  2640.         DO
  2641.           SAY '*** Input error!  First number larger than last number.'CR
  2642.           ITERATE edloop
  2643.         END
  2644.       notchanged=0
  2645.       numdiff=lastnum+1-firstnum
  2646.       pasted.=''
  2647.       pasted.0=numdiff
  2648.       k=0
  2649.       DO i=firstnum TO lynes.0
  2650.         j=i+numdiff
  2651.         k=k+1
  2652.         IF k<=numdiff THEN pasted.k=lynes.i
  2653.         lynes.i=lynes.j
  2654.         lynes.j=''
  2655.       END
  2656.       lynes.0=lynes.0-numdiff
  2657.       count=1
  2658.     END
  2659.   ELSE IF edcom='A' THEN  /* append */
  2660.     DO
  2661.       CALL writebuffer(scratch'/EditorFile')
  2662.       notchanged=0
  2663.     END
  2664.   ELSE IF edcom='U' THEN  /* Upload a textfile to append */
  2665.     DO
  2666.       CALL txup(1)
  2667.       notchanged=0
  2668.     END
  2669.   ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'N') THEN
  2670.     DO
  2671.       IF DATATYPE(edcom,'N') THEN
  2672.         DO
  2673.           ednum=edcom
  2674.           edcom='R'
  2675.         END
  2676.       ELSE
  2677.         DO
  2678.           line=pen3'   '
  2679.           IF edcom='L' | edcom='P' THEN line=line'Starting '
  2680.           line=line'Line Number? > 'def
  2681.           ednum=getinput(1 0 line)
  2682.         END
  2683.       IF ~DATATYPE(ednum,'N') THEN ITERATE edloop
  2684.       IF ednum>(lynes.0+1) THEN ITERATE edloop
  2685.       IF edcom='L' THEN
  2686.         DO
  2687.           count=ednum
  2688.           ITERATE edloop
  2689.         END
  2690.       IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
  2691.         DO
  2692.           IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
  2693.             DO
  2694.               filenum=STRIP(WORD(lynes.1,2))
  2695.               num=files.filenum.0
  2696.               keywords=edkeywords(editarg)
  2697.               lynes.1=LEFT(lynes.1,21) keywords
  2698.               alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
  2699.               savefileflag=1
  2700.               notchanged=0
  2701.               ITERATE edloop
  2702.             END
  2703.         END
  2704.       IF ednum<firstedit THEN
  2705.         DO
  2706.           SAY '*** You are not authorized to alter that line!'CR
  2707.           SAY CR
  2708.           ITERATE edloop
  2709.         END
  2710.       IF edcom='R' THEN   /* replace */
  2711.         DO
  2712.           SAY '   Now reads:'CR
  2713.           SAY pen3||RIGHT(ednum,2)||def lynes.ednum||CR
  2714.           OPTIONS PROMPT pen3'........Search text? >'def
  2715.           PARSE PULL stext
  2716.           IF LENGTH(stext)=0 THEN
  2717.             DO
  2718.               IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
  2719.                 ITERATE edloop
  2720.               lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
  2721.               notchanged=0
  2722.               ITERATE edloop
  2723.             END
  2724.           found=POS(UPPER(stext),UPPER(lynes.ednum))
  2725.           IF found=0 THEN
  2726.             DO
  2727.               SAY CR
  2728.               SAY stext' was not found!'CR
  2729.               SAY CR
  2730.               ITERATE edloop
  2731.             END
  2732.           OPTIONS PROMPT pen3'...Replacement text? >'def
  2733.           PARSE PULL rtext
  2734.           lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
  2735.           lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
  2736.           IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
  2737.             DO
  2738.               PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
  2739.               PARSE VAR lynes.3 . 'Lib:' libnam
  2740.               filenum=STRIP(filenum)
  2741.               newc=files.filenum.0
  2742.               libnum=finddirnum(libnam)
  2743.               alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
  2744.               alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
  2745.               alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
  2746.               alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
  2747.               savefileflag=1
  2748.             END
  2749.           SAY 'Done.'CR
  2750.           SAY CR
  2751.           notchanged=0
  2752.         END
  2753.       ELSE IF edcom='I' THEN  /* insert */
  2754.         DO
  2755.           DO i=lynes.0 TO ednum BY -1
  2756.             j=i+1
  2757.             lynes.j=lynes.i
  2758.           END
  2759.           lynes.ednum=''
  2760.           notchanged=0
  2761.           lynes.0=lynes.0+1
  2762.           lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def)
  2763.         END
  2764.       ELSE IF edcom='P' THEN   /* paste */
  2765.         DO
  2766.           DO i=lynes.0 TO ednum BY -1
  2767.             j=i+pasted.0
  2768.             lynes.j=lynes.i
  2769.           END
  2770.           DO k=1 TO pasted.0
  2771.             kk=ednum+k-1
  2772.             lynes.kk=pasted.k
  2773.           END
  2774.           notchanged=0
  2775.           lynes.0=lynes.0+pasted.0
  2776.         END
  2777.     END
  2778. END
  2779. RETURN 0
  2780.  
  2781.  
  2782. editor:
  2783. toname=''
  2784. msgnum=0
  2785. thechosen.=''
  2786. PARSE ARG edtype toname msgnum .
  2787. IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
  2788. ELSE 
  2789.   DO
  2790.     IF edtype='MSG' THEN
  2791.       DO
  2792.         tempmsgdir=0
  2793.         IF DATATYPE(arg,'N') THEN tempmsgdir=arg
  2794.         IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN
  2795.           msgdir=tempmsgdir
  2796.         ELSE IF areaselect() THEN RETURN
  2797.       END
  2798.     lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  2799.   END
  2800. IF toname='' THEN
  2801.   DO
  2802.     IF edtype='MAIL' THEN
  2803.       DO
  2804.         CALL selectchosen(1 pen3'Send' edtype lastwrit+1 'To: 'def)
  2805.         toname=thechosen.1
  2806.       END
  2807.     ELSE toname=getinput(1 0 pen3'Post Message To: 'def)
  2808.   END
  2809. toname=SPACE(toname,1,'_')
  2810. toname=cleanstring(1':'toname)
  2811. IF toname='' | FIND(exclusion,toname)>0 THEN
  2812.   DO
  2813.     IF toname='' & edtype='MSG' THEN toname='ALL'
  2814.     ELSE toname=sysop
  2815.     SAY pen3'*** Re-Addressed to'def toname||CR
  2816.   END
  2817. IF toname~='ALL' THEN
  2818.   DO
  2819.     IF toname='BBBBS' THEN toname=sysop
  2820.     IF FIND(userlist,toname)=0 THEN
  2821.       DO
  2822.         IF courtesy='' THEN CALL loadcourtesy()
  2823.         IF FIND(courtesy,toname)=0 THEN
  2824.           DO
  2825.             SAY CR
  2826.             SAY bak2' 'toname' is not on the user list! 'def||CR
  2827.             IF edtype='MAIL' THEN
  2828.               DO
  2829.                 CALL showuserlist()
  2830.                 RETURN 0
  2831.               END
  2832.             ELSE
  2833.               DO
  2834.                 IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN
  2835.                   DO
  2836.                     IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
  2837.                       CALL showuserlist()
  2838.                     RETURN 0
  2839.                   END
  2840.               END
  2841.           END
  2842.       END
  2843.   END
  2844. IF edtype='MAIL' THEN
  2845.   DO
  2846.     CALL MAKEDIR(bbspath'EMail/'toname)
  2847.     mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  2848.   END
  2849. ELSE
  2850.   DO
  2851.     CALL MAKEDIR(msgpath||msgdir)
  2852.     mailname=msgpath||msgdir'/'lastwrit+1
  2853.   END
  2854. lynes.=''
  2855. lynes.0=6
  2856. IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1  /* FILE: filename */
  2857. ELSE lynes.1='  Msg:' lastwrit+1          /* Msg: MSG# REPLY # # ... */
  2858. lynes.2=' From:' name
  2859. IF city~='' THEN lynes.2=lynes.2' - 'city
  2860. lynes.3='   To:' toname                       /*  To: toname   MSG # */
  2861. IF edtype='MAIL' THEN
  2862.   DO
  2863.     IF readopen(bbspath||'Users/'toname) THEN
  2864.       DO
  2865.         CALL READLN(f)
  2866.         CALL READLN(f)
  2867.         temp=READLN(f)
  2868.         CALL CLOSE(f)
  2869.         temp=docity(temp)
  2870.         IF temp~='' THEN lynes.3=lynes.3' - 'temp
  2871.       END
  2872.     IF replysubj='|@NEW@|' THEN
  2873.       DO
  2874.         CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
  2875.         replysubj='Welcome to' bbsname
  2876.       END
  2877.   END
  2878. subj=''
  2879. IF edtype='REPLY' THEN
  2880.   DO
  2881.     subj=SUBSTR(forthline,WORDINDEX(forthline,2))
  2882.     SAY pen3'Subj:'def subj||CR
  2883.     temp=getinput(0 0 'Change the current subject? (Ny) > ')
  2884.     IF LENGTH(temp)>3 THEN subj=temp
  2885.     ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
  2886.   END
  2887. ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj
  2888. IF subj='' THEN
  2889.   DO
  2890.     IF opt='C' THEN subj='FEEDBACK'
  2891.     ELSE
  2892.       DO
  2893.         SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR
  2894.         subj=getinput(0 0 pen3': 'def)
  2895.       END
  2896.   END
  2897. IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
  2898. IF subj='' THEN subj='?'
  2899. lynes.4=' Subj:' subj
  2900. lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
  2901. IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
  2902. lynes.6=INSERT('','',1,74,'=')
  2903. IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
  2904. DO i=1 TO lynes.0
  2905.   SAY lynes.i||CR
  2906. END
  2907. CALL writebuffer(scratch'/MessageFile')
  2908. IF savelines(mailname) THEN RETURN 0
  2909. CALL seelines(1)
  2910. IF thechosen.0='' THEN
  2911.   DO
  2912.     thechosen.0=1
  2913.     thechosen.1=toname
  2914.   END
  2915. carbons=thechosen.0+1
  2916. DO FOREVER
  2917.   IF thechosen.0>=carbons THEN
  2918.     DO
  2919.       junk='Copies To:'
  2920.       DO cci=carbons TO thechosen.0
  2921.         junk=junk thechosen.cci
  2922.       END
  2923.       SAY junk||CR
  2924.     END
  2925.   pline=''
  2926.   IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  2927.   pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
  2928.   pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
  2929.   junk=getinput(1 1 pline)
  2930.   IF junk='E' THEN
  2931.     DO
  2932.       IF level>sysoplevel THEN firstedit=1
  2933.       ELSE firstedit=7
  2934.       IF bbsED(firstedit mailname)=2 THEN RETURN 0
  2935.       junk='R'
  2936.     END
  2937.   ELSE IF edtype='MAIL' & junk='C' THEN
  2938.     DO
  2939.       CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
  2940.       junk='R'
  2941.     END
  2942.   ELSE IF junk='K' THEN
  2943.     DO
  2944.       IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'CR
  2945.       RETURN 0
  2946.     END
  2947.   ELSE IF junk='U' THEN
  2948.     DO
  2949.       CALL txup(0 mailname)
  2950.       junk='R'
  2951.     END
  2952.   IF junk='R' THEN
  2953.     DO
  2954.       CALL readlines(mailname 1)
  2955.       CALL seelines(1)
  2956.       nonstop=0
  2957.     END
  2958.   ELSE BREAK
  2959. END
  2960. IF edtype='MAIL' THEN
  2961.   DO
  2962.     IF replysubj~='' & readname~='' & uname~='' & uname~='UNAME' THEN
  2963.       DO
  2964.         junk=getinput(1 1 'Attach original mail from' uname'? (nY) > ')
  2965.         IF junk~='N' THEN
  2966.           DO
  2967.             arg=bbspath'Email/'name'/'readname
  2968.             IF ~readlines(arg 1) THEN CALL savelines(mailname)
  2969.           END
  2970.       END
  2971.     junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
  2972.     IF junk='Y' THEN
  2973.       DO
  2974.         savearg=arg
  2975.         arg=getinput(0 0 'Filename: ')
  2976.         curdir=PRAGMA('D')
  2977.         CALL MAKEDIR(bbspath'EmailFiles/'toname)
  2978.         CALL setdir(bbspath'EmailFiles/'toname)
  2979.         DO WHILE uload(0)=2
  2980.         END
  2981.         IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
  2982.           DO
  2983.             CALL readlines(mailname 1)
  2984.             IF arg~='' THEN lynes.1=lynes.1'  FILE: 'arg
  2985.             CALL setdir(curdir)
  2986.             CALL DELETE(mailname)
  2987.             CALL savelines(mailname)
  2988.           END
  2989.         ELSE
  2990.           DO
  2991.             CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
  2992.             SAY pen3'*** Upload failed! ***'def||CR
  2993.           END
  2994.         arg=savearg
  2995.       END
  2996.     totmail=WORD(data.17,2)
  2997.     IF ~DATATYPE(totmail,'N') THEN totmail=1
  2998.     ELSE totmail=totmail+1
  2999.     data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  3000.   END
  3001. IF edtype~='MAIL' THEN totwrit.msgdir=totwrit.msgdir+1
  3002. CALL readlines(mailname 1)
  3003. DO ui=1 TO thechosen.0
  3004.   IF thechosen.ui='' THEN ITERATE ui
  3005.   IF ui>1 THEN
  3006.     DO
  3007.       CALL MAKEDIR(bbspath'Email/'thechosen.ui)
  3008.       newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
  3009.       IF ui<carbons THEN lynes.3='   To:' thechosen.ui
  3010.       ELSE
  3011.         DO
  3012.           lynes.1=lynes.1'  (Carbon Copy)'
  3013.           lynes.3='   To:' thechosen.1
  3014.         END
  3015.       CALL savelines(newname)
  3016.       IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
  3017.         DO
  3018.           CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
  3019.           ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
  3020.           line2='Copied' WORD(lynes.1,4)
  3021.           SAY line2 'to the' thechosen.ui 'file area.'CR
  3022.           CALL send2log(line2)
  3023.         END
  3024.     END
  3025.   line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui
  3026.   IF edtype~='MAIL' THEN
  3027.     DO
  3028.       IF FIND(userlist,thechosen.ui)>0 THEN
  3029.         CALL msgmark(thechosen.ui msgdir lastwrit+1)
  3030.       line=line 'in' msg.msgdir
  3031.     END
  3032.   CALL send2log(line)
  3033.   line=edtype 'Sent To' thechosen.ui
  3034.   IF edtype='MAIL' THEN
  3035.     DO
  3036.       IF emailonline>=0 THEN emailonline=emailonline+1
  3037.     END
  3038.   ELSE
  3039.     DO
  3040.       grand=grand+1
  3041.       IF ~DATATYPE(msg.msgdir.0,'N') THEN msg.msgdir.0=1
  3042.       ELSE msg.msgdir.0=msg.msgdir.0+1
  3043.       line=line 'in the'pen3 msg.msgdir def'conference.'
  3044.     END
  3045.   SAY line||CR
  3046. END
  3047. IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
  3048. ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
  3049. CALL setdir(libpath||dirs.1)
  3050. thechosen.=''
  3051. RETURN 1
  3052.  
  3053.  
  3054. txup:
  3055. PARSE ARG upflg uparg .
  3056. SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
  3057. pline='Are you SURE your file is un-compressed text? (Ny) > '
  3058. IF getinput(1 1 pline)='Y' THEN
  3059.   DO
  3060.     savearg=arg
  3061.     arg='UploadFile'
  3062.     curdir=PRAGMA('D')
  3063.     CALL setdir(scratch)
  3064.     CALL DELETE(arg)
  3065.     CALL DELETE('tempfile1')
  3066.     IF uload(0)=0 THEN
  3067.       DO
  3068.         IF upflg=0 THEN
  3069.           DO
  3070.             ADDRESS COMMAND 'C:copy' uparg 'tempfile1'
  3071.             CALL DELETE(uparg)
  3072.             ADDRESS COMMAND 'C:join tempfile1 UploadFile AS' uparg
  3073.           END
  3074.         ELSE IF upflg=1 THEN
  3075.           DO
  3076.             CALL readlines(arg lynes.0+1)
  3077.             notchanged=0
  3078.           END
  3079.       END
  3080.     CALL setdir(curdir)
  3081.     arg=savearg
  3082.   END
  3083. RETURN
  3084.  
  3085.  
  3086. msgmark:
  3087. PARSE ARG markname markdir markmsg .
  3088. IF OPEN(f,bbspath'Users/'markname)=0 THEN RETURN
  3089. mlines.=''
  3090. DO mi=1 TO 24
  3091.   mlines.mi=READLN(f)
  3092. END
  3093. mlines.24=STRIP(mlines.24 markdir'/'markmsg)
  3094. CALL SEEK(f,0,'B')
  3095. DO mi=1 TO 24
  3096.   CALL WRITELN(f,mlines.mi)
  3097. END
  3098. CALL CLOSE(f)
  3099. RETURN
  3100.  
  3101.  
  3102. shell:
  3103. SAY CR
  3104. DO WHILE(UPPER(opt)~='EXIT')
  3105.   SAY bak2||TIME('C')||def PRAGMA('D')||CR
  3106.   OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
  3107.   PARSE PULL opt' 'arg .
  3108.   CALL checkdcd()
  3109.   IF(UPPER(opt)='CD') THEN CALL setdir(arg)
  3110.   ELSE IF exists(opt)~=0 THEN
  3111.     DO
  3112.       IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
  3113.     END
  3114.   ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
  3115.     ADDRESS COMMAND opt '<* >*' arg
  3116. END
  3117. RETURN
  3118.  
  3119.  
  3120. yellsnd:
  3121. IF EXISTS(bbspath'BBS_TEXT/YELL.snd') & EXISTS('c:Sound') THEN
  3122.   ADDRESS COMMAND 'C:Run C:Sound' bbspath'BBS_TEXT/YELL.snd'
  3123. RETURN
  3124.  
  3125.  
  3126. yell:
  3127. chatrequest=1
  3128. IF excuses.1='' THEN
  3129.   DO
  3130.     IF readopen(bbspath'Lists/Excuses') THEN
  3131.       DO
  3132.         DO i=1
  3133.           line=READLN(f)
  3134.           IF EOF(f) THEN BREAK
  3135.           excuses.i=line
  3136.         END
  3137.         excuses.0=i-1
  3138.         CALL CLOSE(f)
  3139.       END
  3140.   END
  3141. j=TIME('S')//excuses.0+1
  3142. SAY CR
  3143. SAY 'Sorry, your SysOp,' sysop','CR
  3144. IF excuses.j~='' THEN SAY excuses.j||CR
  3145. ELSE SAY 'is not available, please leave a ['pen3'C'def']omment.'CR
  3146. SAY CR
  3147. IF bbsprefs.13 THEN RETURN
  3148. SAY 'I''m yelling anyway...'CR
  3149. SAY 'If nobody answers, please try again later or leave a ['pen3'C'def']omment'CR
  3150. CALL yellsnd()
  3151. IF SHOWLIST('H','SPEAK') THEN  /* check on SPEAK: device */
  3152.   DO
  3153.     IF EXISTS(bbspath'BBS_TEXT/YELL') THEN /* we have yell file */
  3154.       ADDRESS COMMAND 'C:Run C:Type >SPEAK:' bbspath'BBS_TEXT/YELL'
  3155.     ELSE IF writeopen('SPEAK:')~=0 THEN
  3156.       DO
  3157.         CALL WRITELN(f,'Yo sissop.')
  3158.         CALL WRITELN(f,'A uzer wants to chat with you.')
  3159.         CALL WRITELN(f,'Yo sissop.')
  3160.         CALL CLOSE(f)
  3161.       END
  3162.   END
  3163. ELSE IF EXISTS(saypath) THEN          /* default to SAY */
  3164.   DO
  3165.     IF EXISTS(bbspath'BBS_TEXT/YELL') THEN /* we have yell file */
  3166.       ADDRESS COMMAND 'C:Run' saypath '-x' bbspath'BBS_TEXT/YELL'
  3167.     ELSE
  3168.       DO
  3169.         ADDRESS COMMAND saypath 'Yo sissop.'
  3170.         ADDRESS COMMAND saypath 'A uzer wants to chat with you.'
  3171.         ADDRESS COMMAND saypath 'Yo sissop.'
  3172.       END
  3173.   END
  3174. RETURN
  3175.  
  3176.  
  3177. /* online change to member. Sysop triggered by BumpMember.baud */
  3178. validate:
  3179. IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
  3180.   DO
  3181.     SAY CR
  3182.     SAY 'You are being validated.  Please wait...'CR
  3183.     SAY CR
  3184.     DO lvi=1 TO 22
  3185.       line=READLN(f)
  3186.       IF lvi=11 THEN data.11=line
  3187.       IF lvi=20 THEN data.20=line
  3188.       IF lvi=21 THEN data.21=line
  3189.     END
  3190.     data.22=line
  3191.     CALL CLOSE(f)
  3192.     CALL SetData()
  3193.     CALL sortlibraries()
  3194.     CALL logonstats()
  3195.     CALL saveData(0)
  3196.     SIGNAL RESTART
  3197.   END
  3198. ELSE MSG bak2'You need a default member file in BBS_TEXT!   ( BBS_TEXT/DEF.MEMBER )'def
  3199. RETURN
  3200.  
  3201.  
  3202. /* online time change. Sysop triggered by BumpTime.baud */
  3203. uptime:
  3204. mins=GETCLIP('BBS_minutes')
  3205. IF DATATYPE(mins,'N') THEN
  3206.   DO
  3207.     IF (mins*60)>maxtime THEN
  3208.       SAY name', this session''s time has been increased to' mins 'minutes.'CR
  3209.     ELSE MSG '*** User has not been told that his time has decreased.'
  3210.     CALL SETCLIP('BBS_minutes')
  3211.     maxtime=mins*60
  3212.   END
  3213. RETURN
  3214.  
  3215.  
  3216. /* online level change. Sysop triggered by BumpLevels.baud */
  3217. uplevel:
  3218. levl=GETCLIP('BBS_level')
  3219. IF DATATYPE(levl,'N') THEN
  3220.   DO
  3221.     IF levl>data.20 THEN
  3222.       SAY name', your level has been changed from' data.20 'to' levl'.'CR
  3223.     ELSE MSG '*** User has not been told his level has been reduced.'
  3224.     data.20=levl
  3225.     CALL SetData()
  3226.     IF menu='NEW' THEN menu='ALL'
  3227.     CALL sortlibraries()
  3228.   END
  3229. RETURN
  3230.  
  3231.  
  3232. /* online ratio change. Sysop triggered by BumpLevels.baud */
  3233. upratio:
  3234. rats=GETCLIP('BBS_ratio')
  3235. IF DATATYPE(rats,'N') THEN
  3236.   DO
  3237.     SAY name', your upload:download ratio has been changed to 1:'rats'.'CR
  3238.     data.17=rats'  'WORD(data.17,2)'  'WORD(data.17,3)
  3239.     CALL SETCLIP('BBS_ratio')
  3240.   END
  3241. RETURN
  3242.  
  3243.  
  3244. bytes2user:
  3245. PARSE ARG indx bytes .
  3246. tfiles=WORD(data.indx,1)
  3247. tbytes=WORD(data.indx,3)
  3248. IF ~DATATYPE(tfiles,'N') THEN tfiles=0
  3249. IF ~DATATYPE(tbytes,'N') THEN tbytes=0
  3250. tbytes=tbytes+bytes
  3251. tfiles=tfiles+1
  3252. IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
  3253. ELSE data.indx='1 file' bytes 'bytes.'
  3254. data.indx=data.indx DATE()
  3255. CALL saveData(0)
  3256. RETURN
  3257.  
  3258.  
  3259. stats:
  3260. ARG indx
  3261. tfail=''
  3262. bytes=''
  3263. Status z
  3264. string=RESULT
  3265. IF RIGHT(BB_VERS,4)>1.59 THEN
  3266.   DO
  3267.     PARSE VAR string . 'Local Name: 'temp . 'Xfer''ed: 'bytes . 'Elapsed Time: 'min':'sec'0A'x .
  3268.     slash=LASTPOS('/',temp)
  3269.     IF slash=0 THEN slash=LASTPOS(':',temp)
  3270.     IF slash~=0 THEN temp=SUBSTR(temp,slash+1)
  3271.   END
  3272. ELSE PARSE VAR string temp' 'min':'sec . 'Bytes:'bytes .
  3273. temp=STRIP(temp)
  3274. min=STRIP(min)
  3275. sec=STRIP(sec)
  3276. bytes=STRIP(bytes)
  3277. IF temp~='' & LEFT(UPPER(STRIP(temp)),8)~=LEFT(UPPER(arg),8) THEN
  3278.   tfail='wrong file' temp
  3279. ELSE IF DATATYPE(min,'N') & DATATYPE(sec,'N') & DATATYPE(bytes,'N') THEN
  3280.   DO
  3281.     secs=(min*60)+sec
  3282.     IF indx=14 THEN CALL DELAY(100) /* wait for dos to finish upload */
  3283.     temp=STATEF(PRAGMA('D')'/'arg)
  3284.     temp=WORD(temp,2)
  3285.     IF ~DATATYPE(temp,'N') THEN temp=0
  3286.     IF indx=14 & (temp+1024)<bytes THEN tfail='ul size'
  3287.     IF indx=15 & temp>(bytes+1024) THEN tfail='dl size'
  3288.   END
  3289. ELSE tfail='not numeric: min='min 'sec='sec 'bytes='bytes
  3290. IF tfail~='' THEN
  3291.   DO
  3292.     line=plaindir'/'arg pen3'*** Transfer failed! ***'def
  3293.     SAY line||CR
  3294.     CALL send2log(line 'tfail:'tfail)
  3295.     Remote OFF
  3296.     Send '^G\w^G^G'
  3297.     Remote ON
  3298.     RETURN 1
  3299.   END
  3300. ELSE IF secs>0 THEN
  3301.   Say 'Transfer Speed:' TRUNC(bytes/secs+.05,1) 'characters per second.'CR
  3302. Remote OFF
  3303. Send '^G'
  3304. Remote ON
  3305. line=left(arg,16,' ')
  3306. IF indx=14 THEN
  3307.   DO
  3308.     temp=countcheck(bbspath'Numbers/Bytes.UpLoad' 0)+bytes
  3309.     CALL countcheck(bbspath'Numbers/Bytes.UpLoad' temp)
  3310.     line=line 'uled'
  3311.   END
  3312. ELSE
  3313.   DO
  3314.     temp=countcheck(bbspath'Numbers/Bytes.DownLoad' 0)+bytes
  3315.     CALL countcheck(bbspath'Numbers/Bytes.DownLoad' temp)
  3316.     temp=countcheck(bbspath'Numbers/Files.DownLoad' 0)+1
  3317.     CALL countcheck(bbspath'Numbers/Files.DownLoad' temp)
  3318.     temp=PRAGMA('D')
  3319.     xdev=LEFT(temp,POS(':',temp)-1)
  3320.     temp=countcheck(bbspath'Numbers/Bytes.X.'xdev 0)+bytes
  3321.     CALL countcheck(bbspath'Numbers/Bytes.X.'xdev temp)
  3322.     temp=countcheck(bbspath'Numbers/Files.X.'xdev 0)+1
  3323.     CALL countcheck(bbspath'Numbers/Files.X.'xdev temp)
  3324.     line=line 'dled'
  3325.   END
  3326. line=line protocol TIME('C') bytes 'bytes' PRAGMA('D')
  3327. CALL send2log(line)
  3328. RETURN 0
  3329.  
  3330.  
  3331. bbsspace:
  3332. ARG tabspace .
  3333. ADDRESS COMMAND 'C:info >ram:infout' bbsdevice
  3334. ok=OPEN(f,'ram:infout','R')
  3335. IF ok=0 THEN RETURN 20
  3336. line=READLN(f)
  3337. line=READLN(f)
  3338. line=READLN(f)
  3339. line=READLN(f)
  3340. CALL CLOSE(f)
  3341. IF tabspace<14 THEN SAY CR
  3342. bbsk=WORD(line,4)
  3343. IF ~DATATYPE(bbsk,'N') THEN
  3344.   DO
  3345.     line=bbsdevice 'is not an info compatible device!'
  3346.     CALL send2log(line)
  3347.     SAY pen3||line||def||CR
  3348.     bbsk=0
  3349.     RETURN
  3350.   END
  3351. bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
  3352. IF bbsk<1 THEN bbsk=0
  3353. SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
  3354. RETURN
  3355.  
  3356.  
  3357. comma:
  3358. ARG num .
  3359. dgt=LENGTH(num)
  3360. numtext=''
  3361. IF dgt>3 THEN numtext=','RIGHT(num,3)
  3362. IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
  3363. IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
  3364. IF dgt>12 THEN
  3365.   DO
  3366.     numtext=','LEFT(RIGHT(num,12),3)||numtext
  3367.     numtext=LEFT(num,dgt-12)||numtext
  3368.   END
  3369. ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
  3370. ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
  3371. ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
  3372. ELSE numtext=num
  3373. RETURN numtext
  3374.  
  3375.  
  3376. uload:
  3377. ARG frommenu
  3378. CALL bbsspace(12)
  3379. SAY CR
  3380. IF bbsk<1 THEN
  3381.   DO
  3382.     line='Upload area is full!'
  3383.     CALL send2log(line)
  3384.     SAY pen3||line||def||CR
  3385.     RETURN 1
  3386.   END
  3387. IF arg='' THEN arg=getinput(0 0 'Filename: ')  /* no filename given */
  3388. IF arg='' THEN RETURN 1
  3389. arg=COMPRESS(arg,' :/,;|')  /* be sure no illegals here */
  3390. IF frommenu THEN
  3391.   DO
  3392.     SAY 'Checking filelist...'CR
  3393.     filenum=countcheck(bbspath'Numbers/LastFile' 0)
  3394.     DO ui=1 TO filenum
  3395.       IF UPPER(WORD(files.ui,2))=UPPER(arg) THEN
  3396.         DO
  3397.           temp=WORD(files.ui,1)
  3398.           line=pen3'*** File' arg 'already exists here in the'
  3399.           line=line temp 'directory.'def
  3400.           SAY line||CR
  3401.           SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR
  3402.           RETURN 1
  3403.         END
  3404.     END
  3405.     CALL cleanline(1)
  3406.     IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(bbslibs'Sysops')
  3407.     ELSE
  3408.       DO loop=1
  3409.         SAY 'Please select an appropriate library for -' pen3||arg def'-'CR
  3410.         IF chdir()=0 THEN LEAVE loop
  3411.       END
  3412.   END
  3413. checkproto='T'
  3414. targ=arg
  3415. DO WHILE checkproto='T'
  3416.   arg=''
  3417.   SAY CR
  3418.   SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  3419.   pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  3420.   pline=pline '['pen3'U'def']pload (qtU) > '
  3421.   checkproto=getinput(1 1 pline)
  3422.   IF checkproto='Q' THEN RETURN 1
  3423.   IF checkproto='T' THEN CALL chpro()
  3424. END
  3425. arg=targ
  3426. CALL postuser(4)
  3427. uploadtime=TIME('E')
  3428. SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
  3429. CALL whodat()
  3430. DownLoad arg
  3431. IF RC>0 | stats(14) THEN RETURN 2
  3432. rbytes=WORD(STATEF(arg),2)
  3433. IF rbytes<1 THEN
  3434.   DO
  3435.     CALL DELETE(arg)
  3436.     RETURN 2
  3437.   END
  3438. temp=''
  3439. DO WHILE temp~='N' & temp~='Y'
  3440.   OPTIONS PROMPT 'Received' rbytes 'bytes. Was your upload successful? (ny) > '
  3441.   PULL temp
  3442.   temp=LEFT(temp,1)
  3443. END
  3444. IF temp='N' THEN RETURN 2
  3445. CALL bytes2user(14 rbytes)
  3446. ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
  3447. IF bbsprefs.9 & name~=sysop THEN
  3448.   DO
  3449.     newufile=bbspath'EMail/'sysop'/NEW_FILES'
  3450.     IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
  3451.     ELSE
  3452.       DO
  3453.         ok=OPEN(f,newufile,'W')
  3454.         IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***') 
  3455.       END
  3456.     IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
  3457.     CALL CLOSE(f)
  3458.   END
  3459. IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
  3460. DO ui=sysoplevel+2 TO 100
  3461.   IF UPPER(dirs.ui)=UPPER(temp) THEN RETURN 0     /* no filenotes */
  3462. END
  3463. IF frommenu THEN
  3464.   DO
  3465.     uploadtime=TIME('E')-uploadtime
  3466.     IF bbsprefs.11 THEN
  3467.       DO
  3468.         maxtime=maxtime+uploadtime
  3469.         line='This session''s time has been increased by'
  3470.         line=line TRUNC(uploadtime%60+.05,1)+1 'minutes.'
  3471.         SAY CR
  3472.         SAY line||CR
  3473.       END
  3474.     DO WHILE editnote(arg)  /* INSIST on a filenote */
  3475.     END
  3476.     SAY pen3'Thank you for contributing to the' bbsname 'file libraries!'def||CR
  3477.   END
  3478. waitchar=''
  3479. RETURN 0
  3480.  
  3481.  
  3482. findfiles:
  3483. PARSE ARG ffile .
  3484. IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
  3485. IF DATATYPE(ffile,'N') THEN
  3486.   DO
  3487.     IF WORDS(files.ffile)<2 THEN RETURN 0
  3488.     dirtemp=WORD(files.ffile,1)
  3489.     IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
  3490.       DO
  3491.         CALL illegal_access()
  3492.         RETURN 0
  3493.       END
  3494.     CALL setdir(libpath||dirtemp)
  3495.   END
  3496. ELSE IF EXISTS(ffile) THEN
  3497.   DO
  3498.     IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
  3499.       DO
  3500.         IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
  3501.           DO
  3502.             line=READLN(f)
  3503.             CALL CLOSE(f)
  3504.             ffile=WORD(line,2)
  3505.           END
  3506.       END
  3507.   END
  3508. ELSE
  3509.   DO
  3510.     nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1
  3511.     DO ui=nextfilenum TO 0 BY -1
  3512.       IF ui<1 THEN
  3513.         DO
  3514.           SAY CR
  3515.           SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR
  3516.           SAY CR
  3517.           RETURN 0
  3518.         END
  3519.       argtemp=WORD(files.ui,2)
  3520.       IF UPPER(argtemp)=UPPER(ffile) THEN
  3521.         DO
  3522.           dirtemp=WORD(files.ui,1)
  3523.           jj=files.ui.0
  3524.           IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
  3525.             DO
  3526.               CALL illegal_access()
  3527.               RETURN 0
  3528.             END
  3529.           ffile=ui
  3530.           CALL setdir(libpath||dirtemp)
  3531.           LEAVE ui
  3532.         END
  3533.     END
  3534.   END
  3535. ftemp=ffile
  3536. IF DATATYPE(ftemp,'N') THEN ftemp=WORD(files.ftemp,2)
  3537. IF ~EXISTS(ftemp) THEN
  3538.   DO
  3539.     finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
  3540.     IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
  3541.     IF ~EXISTS(ftemp) THEN
  3542.       DO
  3543.         IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'CR
  3544.         ELSE
  3545.           DO
  3546.             SAY CR
  3547.             SAY '***'pen3 plaindir'/'ftemp def'is not currently available online.'CR
  3548.             SAY 'Please leave email to your sysop'pen3 sysop||def', to receive this file.'CR
  3549.             SAY CR
  3550.           END
  3551.         RETURN 0
  3552.       END
  3553.   END
  3554. RETURN ffile
  3555.  
  3556.  
  3557. illegal_access:
  3558. SAY CR
  3559. SAY '*** You are not authorized to access' ffile'!'CR
  3560. SAY '*** Send Email to' sysop 'to receive a higher level.'CR
  3561. SAY CR
  3562. CALL send2log('Illegal Access Attempt!' ffile 'in' dirtemp)
  3563. RETURN
  3564.  
  3565.  
  3566. statuscheck:
  3567. PARSE ARG ffile
  3568. updownratio=WORD(data.17,1)
  3569. IF ~DATATYPE(updownratio,'N') THEN updownratio=100
  3570. upbytes=WORD(data.14,3)
  3571. IF ~DATATYPE(upbytes,'N') | upbytes<1 THEN upbytes=1
  3572. dnbytes=WORD(data.15,3)
  3573. IF ~DATATYPE(dnbytes,'N') | dnbytes<1 THEN dnbytes=1
  3574. dbytes=WORD(STATEF(ffile),2)
  3575. IF ~DATATYPE(dbytes,'N') THEN dbytes=1
  3576. IF ~DATATYPE(bps,'N') THEN bps=2400
  3577. needtime=dbytes%(bps%10)+10  /* plus 10 seconds for handshaking? */
  3578. SAY CR
  3579. SAY CR
  3580. CALL showtime()
  3581. SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR
  3582. SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR
  3583. IF level>(sysoplevel+1) | POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
  3584. IF (needtime+TIME('E'))>maxtime THEN
  3585.   DO
  3586.     SAY CR
  3587.     SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR
  3588.     CALL send2log(needtime%60 'mins needed to dl' ffile 'at' dbytes 'bytes!'def)
  3589.     IF needtime>(WORD(data.11,1)*60) THEN
  3590.       SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR
  3591.     SAY CR
  3592.     RETURN 1
  3593.   END
  3594. IF updownloadratio>0 & (dnbytes/upbytes)>updownratio THEN
  3595.   DO
  3596.     SAY CR
  3597.     line=pen3'       *** You must upload before you do any more downloading! ***'def
  3598.     SAY line||CR
  3599.     CALL send2log('*** Exceeded Download Ratio 1:'TRUNC(dnbytes/upbytes))
  3600.     SAY '  Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR
  3601.     IF bbsprefs.4 THEN RETURN 1
  3602.     SAY pen3'             - This requirement is temporarily suspended. -'def||CR
  3603.     SAY CR
  3604.   END
  3605. RETURN 0
  3606.  
  3607.  
  3608. showxdevs: PROCEDURE EXPOSE bbspath pen3 def CR 
  3609. CALL FileList(bbspath'Numbers/Files.X.*',xfiles,'F','N')
  3610. IF xfiles.0>1 THEN CALL QSORT(1,xfiles.0,xfiles)
  3611. DO i=1 TO xfiles.0
  3612.   ii=LASTPOS('FILES.X.',UPPER(xfiles.i))+8
  3613.   temp=SUBSTR(xfiles.i,ii)
  3614.   SAY RIGHT(comma(countcheck(bbspath'Numbers/Bytes.X.'temp 0)),15) 'bytes  in' RIGHT(comma(countcheck(bbspath'Numbers/Files.X.'temp 0)),7)' files downloaded from' pen3||temp||def||CR
  3615. END
  3616. SAY LEFT('-',74,'-')||CR
  3617. RETURN
  3618.  
  3619.  
  3620. ext_dload:
  3621. SAY CR
  3622. CALL checkdcd()
  3623. allargs=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
  3624. IF allargs='' | TRUNC(maxtime-TIME('E'))<30 THEN RETURN
  3625. CALL dload2()
  3626. RETURN
  3627.  
  3628.  
  3629. dload:
  3630. arg=STRIP(arg data.25)
  3631. data.25=''
  3632. curdir=PRAGMA('D')
  3633. OPTIONS PROMPT 'Filenames and/or numbers: '
  3634. IF arg='' THEN PARSE PULL arg  /* no filename given */
  3635. IF arg='' THEN RETURN 0
  3636. allargs=TRANSLATE(arg,'     ',':/,;|')
  3637. tempargs=SPACE(allargs,1)
  3638. SAY 'Working...'lineup||CR
  3639. IF POS('EMAILFILES',curdir)=0 THEN
  3640.   DO di=1 TO WORDS(tempargs) WHILE STRIP(allargs)~=''
  3641.     arg=WORD(tempargs,di)
  3642.     wloc=WORDINDEX(allargs,FIND(allargs,arg))
  3643.     temp=findfiles(arg)
  3644.     IF temp~=arg THEN
  3645.       DO
  3646.         allargs=DELWORD(allargs,FIND(allargs,arg),1)
  3647.         IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1)
  3648.       END
  3649.   END
  3650.  
  3651. dload2:
  3652. curdir=PRAGMA('D')
  3653. allargs=STRIP(data.25 allargs)
  3654. data.25=''
  3655. IF allargs='' THEN RETURN 0
  3656. sleepy='T'
  3657. DO WHILE sleepy='T'
  3658.   arg=''
  3659.   SAY CR
  3660.   temp=WORD(allargs,1)
  3661.   IF DATATYPE(temp,'N') THEN temp=WORD(files.temp,2)
  3662.   test=''
  3663.   IF LENGTH(temp)>40 THEN
  3664.     DO
  3665.       test=temp
  3666.       temp=''
  3667.     END
  3668.   SAY 'Filename(s)'pen3 LEFT(temp,40) def'Protocol:'pen3 protocol||def||CR
  3669.   IF test~='' THEN SAY '           'pen3 test||def||CR
  3670.   DO di=2 TO WORDS(allargs) /* emailfile will not get here */
  3671.     temp=WORD(allargs,di)
  3672.     IF DATATYPE(temp,'N') THEN temp=WORD(files.temp,2)
  3673.     SAY '           'pen3 temp||def||CR
  3674.   END
  3675.   pline='['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload'
  3676.   pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)'
  3677.   sleepy=getinput(1 1 pline '> ')
  3678.   IF sleepy='Q' THEN RETURN 0
  3679.   IF sleepy='A' THEN sleepy='LOGOFF'
  3680.   IF sleepy='T' THEN CALL chpro()
  3681. END
  3682. DO WHILE allargs~=''
  3683.   errorflag=0
  3684.   extdir=''
  3685.   arg=WORD(allargs,1)
  3686.   allargs=STRIP(DELWORD(allargs,1,1))
  3687.   IF DATATYPE(arg,'N') THEN
  3688.     DO
  3689.       CALL setdir(libpath||WORD(files.arg,1))
  3690.       arg=WORD(files.arg,2)
  3691.     END
  3692.   notename=bbspath'FileNotes/'plaindir'/'arg
  3693.   finfo=''
  3694.   IF ~EXISTS(arg) THEN
  3695.     DO
  3696.       finfo=STATEF(notename)
  3697.       IF WORDS(finfo)>7 THEN
  3698.         DO
  3699.           temp=plaindir
  3700.           x=lastslash(WORD(finfo,8))
  3701.           arg=WORD(x,1)
  3702.           CALL setdir(WORD(x,2))
  3703.           plaindir=temp
  3704.         END
  3705.     END
  3706.   x=lastslash(arg)
  3707.   IF WORDS(x)>1 THEN
  3708.     DO
  3709.       arg=WORD(x,1)
  3710.       extdir=WORD(x,2)
  3711.       CALL setdir(extdir)
  3712.     END
  3713.   DO dloadloop=1
  3714.     IF statuscheck(arg) THEN
  3715.       DO
  3716.         errorflag=1
  3717.         LEAVE dloadloop
  3718.       END
  3719.     CALL postuser(5)
  3720.     SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
  3721.     CALL checktime()
  3722.     UpLoad arg
  3723.     IF RC>0 | stats(15) THEN
  3724.       DO
  3725.         errorflag=1
  3726.         LEAVE dloadloop
  3727.       END
  3728.     CALL bytes2user(15 WORD(STATEF(arg),2))
  3729.     IF extdir='' & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 THEN
  3730.       DO dloadloop2=1 TO 1
  3731.         DO di=sysoplevel+2 TO 100
  3732.           IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop2
  3733.         END
  3734.         IF readlines(notename 1) THEN
  3735.           DO
  3736.             CALL send2log('Unable to increment download count for' plaindir'/'arg)
  3737.             LEAVE dloadloop2
  3738.           END
  3739.         dls=WORD(lynes.2,7)
  3740.         IF ~DATATYPE(dls,'N') THEN dls=0
  3741.         lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
  3742.         finfo=STATEF(notename)
  3743.         IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
  3744.         ELSE finfo=''
  3745.         CALL DELETE(notename)
  3746.         CALL savelines(notename)
  3747.         CALL DELAY(28)
  3748.         IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' notename finfo
  3749.         IF WORD(data.16,1)<WORD(lynes.1,2) THEN
  3750.           DO
  3751.             lastbrowse=WORD(lynes.1,2)
  3752.             newfilesdate=DATE('S') TIME()
  3753.           END
  3754.       END
  3755.     LEAVE dloadloop
  3756.   END
  3757. END
  3758. CALL setdir(curdir)
  3759. IF sleepy='LOGOFF' THEN SIGNAL LOGOUT2
  3760. IF errorflag THEN SAY pen3'*** Download Failed!'def||CR
  3761. RETURN errorflag
  3762.  
  3763.  
  3764. lastslash:
  3765. PARSE ARG sarg 
  3766. sdir=''
  3767. slash=LASTPOS('/',sarg)
  3768. IF slash>2 THEN sdir=LEFT(sarg,slash-1)
  3769. ELSE
  3770.   DO
  3771.     slash=LASTPOS(':',sarg)
  3772.     IF slash>0 THEN sdir=LEFT(sarg,slash)
  3773.   END
  3774. IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
  3775. RETURN sarg sdir
  3776.  
  3777.  
  3778. editnote:
  3779. IF arg='' THEN
  3780.   DO
  3781.     PARSE PULL arg .
  3782.     IF arg='' THEN RETURN 0
  3783.   END
  3784. comment=''
  3785. IF ~EXISTS(arg) THEN
  3786.   DO
  3787.     finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
  3788.     temp=''
  3789.     IF WORDS(finfo)>7 THEN comment=WORD(finfo,8)
  3790.     ELSE
  3791.       DO
  3792.         IF level<sysoplevel THEN RETURN 0
  3793.         temp=getinput(1 1 'Is this file on an another device? (Nqy)')
  3794.       END
  3795.     IF temp='Y' THEN
  3796.       DO WHILE comment=''
  3797.         OPTIONS PROMPT 'Enter linkfile using full dev:path/filename > '
  3798.         PARSE PULL comment 
  3799.         comment=STRIP(comment)
  3800.         IF comment='' THEN RETURN 0
  3801.         IF ~EXISTS(comment) THEN comment=''
  3802.       END
  3803.     ELSE IF temp='Q' THEN RETURN 0
  3804.   END
  3805. IF comment='' THEN
  3806.   DO
  3807.     arg=findfiles(arg)
  3808.     IF arg=0 THEN RETURN 0
  3809.     IF DATATYPE(arg,'N') THEN arg=WORD(files.arg,2)
  3810.   END
  3811. filedir=plaindir
  3812. CALL MAKEDIR(bbspath'FileNotes/'filedir)
  3813. IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  3814.   DO
  3815.     SAY pen3'*** Failed to open directory!' filedir||def||CR
  3816.     RETURN 0
  3817.   END
  3818. notename=bbspath'FileNotes/'filedir'/'arg
  3819. lynes.=''
  3820. filenum=countcheck(bbspath'Numbers/LastFile' 0)
  3821. IF level>sysoplevel THEN firstedit=1
  3822. ELSE firstedit=5
  3823. IF EXISTS(notename) THEN
  3824.   DO
  3825.     IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
  3826.     CALL bbsED(firstedit notename)
  3827.     RETURN 0
  3828.   END
  3829. IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
  3830. ELSE filedata=STATEF(comment)
  3831. IF filedata='' THEN
  3832.   DO
  3833.     IF comment='' THEN line=filedir'/'arg
  3834.     ELSE line=comment
  3835.     SAY line 'does not exist!'CR
  3836.     RETURN 0
  3837.   END
  3838. bytes=WORD(filedata,2)
  3839. filenum=filenum+1
  3840. lynes.0=4
  3841. lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
  3842. lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes   Downloads: 0'
  3843. lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')'  Lib: 'filedir
  3844. lynes.4=INSERT('','',1,74,'=')
  3845. lynes.1=lynes.1 edkeywords(arg filedir)
  3846. CALL seelines(1)
  3847. edtype=''
  3848. CALL writebuffer(scratch'/NoteFile')
  3849. IF savelines(notename) THEN RETURN 0
  3850. IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
  3851. fncom='R'
  3852. DO WHILE fncom='R'
  3853.   CALL seelines(1)
  3854.   nonstop=0
  3855.   line='['pen3'E'def']dit'
  3856.   IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  3857.   line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  3858.   IF level>sysoplevel THEN line=line '(ekrS) 'def
  3859.   ELSE line=line '(erS) 'def
  3860.   fncom=getinput(1 1 line)
  3861.   IF fncom='K' & level>sysoplevel THEN
  3862.     DO
  3863.       SAY 'Killing FileNote..'CR
  3864.       CALL DELETE(notename)
  3865.       RETURN 1
  3866.     END
  3867.   ELSE IF fncom='E' THEN
  3868.     DO
  3869.       IF bbsED(firstedit notename)>0 THEN RETURN 0
  3870.       fncom='R'
  3871.     END
  3872.   ELSE IF fncom~='R' THEN
  3873.     DO
  3874.       SAY 'Adjusting filelist...'CR
  3875.       IF filenum<1 THEN filenum=1
  3876.       IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1)
  3877.       CALL countcheck(bbspath'Numbers/LastFile' filenum)
  3878.       files.0=files.0+1
  3879.       newcount=alpha.0+1
  3880.       alpha.0=newcount
  3881.       files.filenum=plaindir arg
  3882.       files.filenum.0=newcount
  3883.       libnum=finddirnum(plaindir)
  3884.       PARSE VAR lynes.1 . 'KeyWords:' keywords
  3885.       alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
  3886.       alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
  3887.       alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
  3888.       alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
  3889.       IF EXISTS(bbspath'Lists/Files') THEN
  3890.         x=OPEN(f,bbspath'Lists/Files','A')
  3891.       ELSE x=OPEN(f,bbspath'Lists/Files','W')
  3892.       IF x=0 THEN
  3893.         DO
  3894.           SAY '*** Failed to open' bbspath'Lists/Files'CR
  3895.           RETURN 0
  3896.         END
  3897.       CALL WRITELN(f,filenum files.filenum)
  3898.       CALL CLOSE(f)
  3899.       IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
  3900.         x=OPEN(f,bbspath'Lists/Files.ALPHA','A')
  3901.       ELSE x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
  3902.       IF x=0 THEN
  3903.         DO
  3904.           SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'CR
  3905.           RETURN 0
  3906.         END
  3907.       CALL WRITELN(f,alpha.newcount)
  3908.       CALL CLOSE(f)
  3909.       sortalphaflag=1
  3910.       savefileflag=1
  3911.       CALL cleanline(1)
  3912.     END
  3913. END
  3914. RETURN 0
  3915.  
  3916.  
  3917. edkeywords:
  3918. PARSE ARG kwarg
  3919. SAY CR
  3920. SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
  3921. SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
  3922. SAY '    Note that only the first 31 characters will be used.'CR
  3923. SAY INSERT('','',1,74,'=')||CR
  3924. templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  3925. SAY CR
  3926. RETURN STRIP(LEFT(templine,32))
  3927.  
  3928.  
  3929. loadfiles:
  3930. SAY def||CR
  3931. SAY 'Loading filelist...'CR
  3932. files.=''
  3933. files.0=0
  3934. IF readopen(bbspath'Lists/Files') THEN
  3935.   DO
  3936.     DO i=1
  3937.       line=READLN(f)
  3938.       IF EOF(f) THEN BREAK
  3939.       num=WORD(line,1)
  3940.       IF DATATYPE(num,'N') THEN files.num=WORD(line,2) WORD(line,3)
  3941.     END
  3942.     files.0=i-1
  3943.     CALL CLOSE(f)
  3944.   END
  3945. RETURN
  3946.  
  3947.  
  3948. savefilelist:
  3949. IF level=99 THEN
  3950.   IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN
  3951.  
  3952. savefilelist2:
  3953. SIGNAL OFF BREAK_E
  3954. IF ckmaint('FILES') THEN RETURN
  3955. CALL savealphalist()
  3956. SAY 'Saving filelist...'CR
  3957. CALL SETCLIP('BBS_maint',1)
  3958. xarg=bbspath'Lists/Files'
  3959. CALL DELETE(xarg)
  3960. filenum=countcheck(bbspath'Numbers/LastFile' 0)
  3961. IF filenum<1 | writeopen(xarg)=0 THEN RETURN
  3962. DO i=1 TO filenum
  3963.   IF files.i='' THEN ITERATE i
  3964.   CALL WRITELN(f,i files.i)
  3965. END
  3966. CALL CLOSE(f)
  3967. CALL SETCLIP('BBS_maint')
  3968. savefileflag=0
  3969. IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
  3970. RETURN
  3971.  
  3972.  
  3973. loadalpha:
  3974. SAY def||CR
  3975. SAY 'Loading the alphabetical filelist...'CR
  3976. IF readopen(bbspath'Lists/Files.ALPHA') THEN
  3977.   DO
  3978.     alpha.=''
  3979.     alpha.0=0
  3980.     DO i=1
  3981.       line=READLN(f)
  3982.       IF EOF(f) THEN BREAK
  3983.       fnum=WORD(line,3)
  3984.       IF DATATYPE(fnum,'N') THEN
  3985.         DO
  3986.           alpha.i=line
  3987.           files.fnum.0=i
  3988.         END
  3989.       ELSE i=i-1
  3990.     END
  3991.     CALL CLOSE(f)
  3992.     alpha.0=i-1
  3993.     IF alpha.0<files.0 THEN buildalpha=1
  3994.   END
  3995. ELSE SAY pen3'*** Lists/Files.ALPHA failed to open for reading!'def||CR
  3996. SAY CR
  3997. RETURN
  3998.  
  3999.  
  4000. ckmaint:
  4001. ARG ckfile .
  4002. IF GETCLIP('BBS_maint')~='' THEN
  4003.   DO
  4004.     DO i=0 TO 23 WHILE GETCLIP('BBS_maint')~=''
  4005.       IF i//2=0 THEN SAY 'Waiting' (24-i)*5 'more seconds for' ckfile 'list update to finish...'CR
  4006.       CALL DELAY(250)
  4007.     END
  4008.     IF i>23 THEN
  4009.       DO
  4010.         line='*** unable to update' ckfile 'list.'
  4011.         CALL send2log(line DATE() TIME('C'))
  4012.         SAY line||CR
  4013.         RETURN 1
  4014.       END
  4015.   END
  4016. RETURN 0
  4017.  
  4018.  
  4019. savealphalist:
  4020. SIGNAL OFF BREAK_E
  4021. IF ckmaint('ALPHA') THEN RETURN
  4022. CALL SETCLIP('BBS_maint',1)
  4023. IF GETCLIP('BBS_localfiles')~='' THEN
  4024.   DO
  4025.     CALL SETCLIP('BBS_localfiles')
  4026.     CALL loadfiles()
  4027.     CALL loadalpha()
  4028.   END
  4029. aarg=bbspath'Lists/Files.ALPHA'
  4030. CALL DELETE(aarg)
  4031. IF sortalphaflag=1 THEN
  4032.   DO
  4033.     SAY 'Alphabetizing' alpha.0 'files...'CR
  4034.     CALL QSORT(1,alpha.0,alpha)
  4035.     DO i=1 TO alpha.0
  4036.       fnum=WORD(alpha.i,3)
  4037.       files.fnum.0=i
  4038.     END
  4039.   END
  4040. sortalphaflag=0
  4041. IF writeopen(aarg)=0 THEN
  4042.   DO
  4043.     SAY '*** Error opening' aarg '!'CR
  4044.     RETURN
  4045.   END
  4046. SAY 'Saving alphabetical filelist...'CR
  4047. DO i=1 TO alpha.0
  4048.   ii=WORD(alpha.i,3)
  4049.   IF files.ii='' THEN alpha.i='0 0' ii '100'
  4050.   IF LEFT(alpha.i,4)~='0 0 ' THEN CALL WRITELN(f,alpha.i)
  4051. END
  4052. CALL CLOSE(f)
  4053. CALL SETCLIP('BBS_maint')
  4054. ADDRESS AREXX bbsALPHA.rexx SUBSTR(extension,2) arccom
  4055. RETURN
  4056.  
  4057.  
  4058. viewuser:
  4059. SAY CR
  4060. SAY bak2' 'name' 'def||CR
  4061. DO i=1 TO 18
  4062.   stuff=data.i
  4063.   IF i=13 | i=14 THEN stuff=DATE(,data.i,'S')
  4064.   SAY RIGHT(i,2)||pen3 text.i||def':' stuff||CR
  4065. END
  4066. CALL waiting()
  4067. RETURN
  4068.  
  4069.  
  4070. edituser:
  4071. IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN
  4072.   DO
  4073.     SAY CR
  4074.     SAY pen3'     - Message Conference Access -'def||CR
  4075.     SAY '[O]ff turns all message conferences OFF.'CR
  4076.     SAY 'Set the last message read by you in ALL message conferences'CR
  4077.     temp=getinput(1 1 ' ['pen3'L'def']ast  ['pen3'F'def']irst  ['pen3'O'def']ff  ['pen3'Q'def']uit  (fLoq) > ')
  4078.     IF temp='Q' THEN RETURN
  4079.     SAY 'Resetting...'lineup||CR
  4080.     data.22=''
  4081.     DO i=1 TO level
  4082.       IF temp='F' THEN num=0
  4083.       ELSE IF temp='O' THEN num=-1
  4084.       ELSE num=countcheck(bbspath'Numbers/LastMessage'i 0)
  4085.       data.22=data.22 num
  4086.     END
  4087.     CALL SetData()
  4088.     CALL sortconferences()
  4089.     CALL savedata(1)
  4090.     RETURN
  4091.   END
  4092. new=0
  4093. change=0
  4094. edata.=''
  4095. edname=name
  4096. DO i=0 TO data.0
  4097.   edata.i=data.i
  4098. END
  4099. num=1
  4100. DO WHILE num~='' | edname~=name
  4101.   IF num='' THEN
  4102.     DO
  4103.       IF change THEN
  4104.         DO
  4105.           CALL SetData()
  4106.           CALL saveData(1)
  4107.           change=0
  4108.         END
  4109.       IF new THEN
  4110.         DO
  4111.           data.=''
  4112.           DO i=0 TO edata.0
  4113.             data.i=edata.i
  4114.           END
  4115.           name=edname
  4116.           new=0
  4117.         END
  4118.       CALL SetData()
  4119.     END
  4120.   maxnum=10
  4121.   IF edata.20>sysoplevel THEN maxnum=20
  4122.   IF edata.20=99 THEN maxnum=24
  4123.   SAY bak2' 'name' 'def||CR
  4124.   maxlines=21
  4125.   IF maxnum=10 THEN maxlines=20
  4126.   DO i=1 TO maxlines
  4127.     IF i=5 & name~=edname & edata.20<99 THEN ITERATE
  4128.     SAY RIGHT(i,2)||pen3 text.i||def':' data.i||CR
  4129.   END
  4130.   IF edata.20>sysoplevel THEN
  4131.     DO
  4132.       line=LEFT(' ',50)
  4133.       IF name=edname THEN line=line'NEW = Change User.'
  4134.       line=pen3||line||def||lineup
  4135.       SAY line||CR
  4136.     END
  4137.   num=getinput(1 0 'Select Line Number To Edit: ')
  4138.   IF num='NEW' & edata.20>sysoplevel & edname=name THEN    /* select a new user */
  4139.     DO
  4140.       new=1
  4141.       IF change THEN
  4142.         DO
  4143.           CALL SetData()
  4144.           CALL saveData(1)
  4145.         END
  4146.       change=0
  4147.       nufile=bbspath'Lists/NEW_USERS'
  4148.       IF EXISTS(nufile) THEN
  4149.         IF ~readlines(nufile 1) THEN CALL seelines(0)
  4150.       savename=name
  4151.       name=getinput(1 0 'New User Name: 'def)
  4152.       name=cleanstring(1':'name)
  4153.       IF loadData()=0 THEN name=savename
  4154.       IF data.20>=edata.20 THEN
  4155.         DO
  4156.           SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
  4157.           name=savename
  4158.           CALL loadData()
  4159.         END
  4160.     END
  4161.   ELSE IF DATATYPE(num,'N') & num>0 THEN
  4162.     DO
  4163.       IF num>maxnum THEN
  4164.         DO
  4165.           SAY CR
  4166.           SAY pen3'You are not authorized to change that information!'def||CR
  4167.           SAY CR
  4168.         END
  4169.       ELSE
  4170.         DO dummy=1 TO 1
  4171.           IF num=8 THEN
  4172.             DO
  4173.               SAY CR
  4174.               SAY 'Use spaces to separate options.'CR
  4175.               SAY 'If the option word is in line 8, it is ON.'CR
  4176.               SAY 'Valid Options:'CR
  4177.               SAY '        MENU   combines all main commands into 1 menu.'CR
  4178.               SAY '        MENUS  splits main commands into 3 menus.'CR
  4179.               SAY '        COLOR  turns ANSI color codes ON.'CR
  4180.               SAY '        PHONE  makes your phone number public.'CR
  4181.               SAY '        STREET makes your street address public.'CR
  4182.               SAY '        TERSE  skips some of the logon procedures.'CR
  4183.               SAY CR
  4184.             END
  4185.           line=RIGHT(num,2)||pen3 text.num||def': '
  4186.           SAY line||data.num||CR
  4187.           temp=getinput(0 0 line)
  4188.           IF temp='' THEN
  4189.             DO
  4190.               IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy
  4191.               IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy
  4192.             END
  4193.           IF num=5 | num=8 THEN temp=UPPER(temp)
  4194.           IF num=20 & DATATYPE(temp,'N') & temp>=edata.20 THEN
  4195.             temp=data.20
  4196.           IF edata.20>sysoplevel & name~=edname THEN line2=name' '
  4197.           ELSE line2=''
  4198.           IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
  4199.           line=text.num':' data.num pen6'CHANGED TO'def temp
  4200.           CALL send2log(line2||line)
  4201.           data.num=temp
  4202.           SAY line||CR
  4203.           SAY CR
  4204.           change=1
  4205.         END
  4206.     END
  4207. END
  4208. IF change THEN
  4209.   DO
  4210.     CALL SetData()
  4211.     CALL saveData(1)
  4212.   END
  4213. RETURN
  4214.  
  4215.  
  4216. getnumber:
  4217. PARSE ARG tprompt
  4218. tnum=''
  4219. DO WHILE ~DATATYPE(tnum,'N')
  4220.   tnum=getinput(1 0 '  'tprompt' > ')
  4221.   mask=COMPRESS(XRANGE(),'0123456789')
  4222.   tnum=COMPRESS(tnum,mask)%1
  4223. END
  4224. IF tnum>0 & tnum<10 THEN tnum='0'tnum
  4225. RETURN tnum
  4226.  
  4227.  
  4228. getbirth:
  4229. data.12=WORD(data.12,1)'  'WORD(data.12,2)'  Birthday:'
  4230. SAY pen3'Please enter your birthday.'def||CR
  4231. month=getnumber('month: (1-12)')
  4232. day=getnumber('  day: (1-31)')
  4233. year=getnumber(' year:       ')
  4234. IF year<100 THEN year=year+1900
  4235. born=year||month||day
  4236. IF born<18750101 | born>(DATE('S')-50000) THEN   /* must be older than 4 */
  4237.   DO
  4238.     born=''
  4239.     IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
  4240.       CALL getbirth()
  4241.   END
  4242. data.12=WORD(data.12,1)'  'WORD(data.12,2)'  'WORD(data.12,3)' 'WORD(born,1)
  4243. RETURN
  4244.  
  4245.  
  4246. getname:
  4247. CALL showuserlist()
  4248. SAY CR
  4249. pline='Please enter your full Email name : '
  4250. name=getinput(1 0 pline)
  4251. IF name='' THEN
  4252.   DO
  4253.     name=getinput(1 0 pline)
  4254.     IF name='' THEN
  4255.       DO
  4256.         SAY 'No name, no entry.  Bye!'CR
  4257.         SIGNAL DONE
  4258.       END
  4259.   END
  4260. name=cleanstring(1':'name)
  4261. IF FIND(userlist,name)>0 | FIND(exclusion,name)>0 THEN
  4262.   DO
  4263.     SAY 'Sorry! That name is taken. Please try again.'CR
  4264.     RETURN 1
  4265.   END
  4266. RETURN 0
  4267.  
  4268.  
  4269. /** see if name is in data */
  4270.  
  4271. checkUser:
  4272. tries=0
  4273. IF name='NEW' THEN
  4274.   DO
  4275.     name=''
  4276.     DO WHILE getname()
  4277.     END
  4278.     CALL postuser(7)
  4279.   END
  4280. IF FIND(userlist,name)=0 THEN
  4281.   DO
  4282.     IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
  4283.       DO
  4284.         nonstop=0
  4285.         CALL readlines(bbspath'BBS_TEXT/NEW' 1)
  4286.         CALL seelines(0)
  4287.         CALL waiting()
  4288.       END
  4289.     SAY CR
  4290.     IF getinput(1 1 'Do you want to register? (nY) > ')='N' THEN
  4291.       DO
  4292.         SAY 'Thanks anyway, bye!'CR
  4293.         line=name 'did not want to register.'
  4294.         SIGNAL OUT2
  4295.       END
  4296.     defile=bbspath'BBS_TEXT/DEF.NEW_USER'
  4297.     CALL loadcourtesy()
  4298.     wordnum=FIND(courtesy,name)
  4299.     IF wordnum>0 THEN
  4300.       DO
  4301.         SAY name', is on the Courtesy List. You will be granted immediate access.'CR
  4302.         courtesy=STRIP(DELWORD(courtesy,wordnum,1))
  4303.         IF writeopen(bbspath'Lists/Courtesy') THEN
  4304.           DO
  4305.             DO i=1 TO WORDS(courtesy)
  4306.               CALL WRITELN(f,WORD(courtesy,i))
  4307.             END
  4308.             CALL CLOSE(f)
  4309.           END
  4310.         defile=bbspath'BBS_TEXT/DEF.COURTESY'
  4311.       END
  4312.     ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'CR
  4313.     IF readlines(defile 1) THEN SIGNAL DONE
  4314.     IF RIGHT(BB_VERS,4)>1.59 THEN DO;Beep 400;Beep 250;Beep 200;Beep 150;END
  4315.     ELSE DO;Beep 600;Beep 400;Beep 300;Beep 200;END  /* new user riff */
  4316.     data.=''
  4317.     data.0=24
  4318.     DO i=6 TO 22
  4319.       data.i=lynes.i
  4320.     END
  4321.     data.12=DATE('S')'  'TIME('C')
  4322.     data.13=data.12
  4323.     lastondate=DATE('I')-1
  4324.     lastontime=TIME('C')
  4325.     x=FIND(UPPER(data.8),'COLOR')
  4326.     test=getinput(1 1 'Does your terminal handle ANSI color codes? (nY) > ')
  4327.     IF test='N' THEN
  4328.       DO
  4329.         IF x>0 THEN data.8=DELWORD(data.8,x,1)
  4330.         CALL colors(0)
  4331.       END
  4332.     ELSE IF x=0 THEN
  4333.       DO
  4334.         data.8=data.8 'COLOR'
  4335.         CALL colors(1)
  4336.       END
  4337.     SAY 'Please enter the password you would like to use here.'CR
  4338.     data.5=getinput(1 0 'Password: ')
  4339.     IF data.5='' THEN
  4340.       DO
  4341.         line=''name 'refused to enter a password.'
  4342.         SIGNAL DONE
  4343.       END
  4344.     data.1=''
  4345.     DO WHILE data.1=''
  4346.       data.1=getinput(0 0 'Full Name: ')
  4347.       IF data.1='' THEN SAY 'You MUST leave your real name!'CR
  4348.     END
  4349.     data.2=getinput(0 0 'Street: ')
  4350.     data.3=getinput(0 0 'City, State Zip: ')
  4351.     data.4=''
  4352.     DO WHILE data.4=''
  4353.       data.4=getinput(0 0 'Phone: ')
  4354.       IF data.4='' THEN
  4355.         SAY sysop 'MUST be able to reach you by phone to validate you!'CR
  4356.     END
  4357.     CALL getbirth()
  4358.     IF bbsprefs.8 THEN
  4359.       DO
  4360.         newufile=bbspath'Lists/NEW_USERS'
  4361.         IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
  4362.         ELSE
  4363.           DO
  4364.             ok=OPEN(f,newufile,'W')
  4365.             IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
  4366.           END
  4367.         IF ok~=0 THEN CALL WRITELN(f,DATE() TIME() name' = 'data.1'   'data.4)
  4368.         CALL CLOSE(f)
  4369.       END
  4370.     data.9=getinput(0 0 'Computer: ')
  4371.     data.10=getinput(0 0 'Interests: ')
  4372.     test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
  4373.     IF test='Y' THEN data.8=data.8 'STREET'
  4374.     test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
  4375.     IF test='Y' THEN data.8=data.8 'PHONE'
  4376.     IF bbsprefs.7>0 THEN
  4377.       DO
  4378.         data.20=bbsprefs.7-1
  4379.         data.11='60 minutes' bbsprefs.16-1 'more times today'
  4380.       END
  4381.     SAY CR
  4382.     IF data.20=0 THEN
  4383.       SAY 'Thank you, the sysop will give you higher access soon.'CR
  4384.     SAY 'Please feel free to leave additional info by using [C]omment.'CR
  4385.     SAY CR
  4386.     CALL SetData()
  4387.     CALL saveData(1)
  4388.     SAY 'Adding' name 'to the user list...'CR
  4389.     newpassword=data.5
  4390.     sortuserflag=1
  4391.     temp=countcheck(bbspath'Numbers/Users' 0)+1
  4392.     CALL countcheck(bbspath'Numbers/Users' temp)
  4393.     CALL DELETE(bbspath'Lists/USERS')
  4394.   END
  4395. ELSE
  4396.   DO
  4397.     IF loadData()=0 THEN SIGNAL DONE
  4398.     PARSE VAR data.11 amins . atimes .
  4399.     lastondate=DATE('I',WORD(data.13,1),'S')
  4400.     lastontime=WORD(data.13,2)
  4401.     IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=bbsprefs.16
  4402.     IF level=99 THEN amins=120
  4403.     data.13=DATE('S')'  'TIME()
  4404.     data.11=amins 'minutes' atimes-1 'more times today'
  4405.     IF atimes<1 & DATE('I')=lastondate THEN
  4406.       DO
  4407.         SAY CR
  4408.         SAY CR
  4409.         line= 'Too many calls today.   Call tomorrow.'
  4410.         SAY line||CR
  4411.         SAY CR
  4412.         SAY CR
  4413.         CALL send2log(line)
  4414.         SIGNAL LOGOUT
  4415.       END
  4416.     data.13=DATE('S')'  'TIME('C')
  4417.     SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR
  4418.     SAY CR
  4419.     passprompt='Enter Password: '
  4420.     DO tries=1 TO 3
  4421.       Send passprompt
  4422.       Remote OFF
  4423.       OPTIONS PROMPT ''
  4424.       newpassword=getinput(1 0 '')
  4425.       Remote ON
  4426.       IF(password=newpassword) THEN
  4427.         DO
  4428.           SAY ''CR
  4429.           LEAVE tries; /* correct password */
  4430.         END
  4431.       IF tries=3 THEN
  4432.         DO             /* 3 tries, hang up */
  4433.           SAY ''CR
  4434.           SAY 'Access terminated.'CR
  4435.           line='*** Bad password ***' newpassword '***'
  4436.           SAY line||CR
  4437.           city=line
  4438.           CALL postuser(6)
  4439.           SIGNAL OUT2
  4440.         END
  4441.       SAY ''lineup'                                 'CR
  4442.       passprompt='Incorrect.  Password: ' /* ask again */
  4443.     END
  4444.   END
  4445. SAY CR
  4446.  
  4447. /* Uncomment section below to have name announced at logon. */
  4448. /*
  4449. IF SHOWLIST('H','SPEAK') THEN
  4450.   DO
  4451.     IF writeopen('SPEAK:')~=0 THEN
  4452.       DO
  4453.         CALL WRITELN(f,'Yo sissop.')
  4454.         CALL WRITELN(f,name 'has logd awn.')
  4455.         CALL CLOSE(f)
  4456.       END
  4457.   END
  4458. ELSE IF EXISTS(saypath) THEN
  4459.   DO
  4460.     ADDRESS COMMAND saypath 'Yo sissop.'
  4461.     ADDRESS COMMAND saypath name 'logd awn.'
  4462.   END
  4463. */
  4464. RETURN
  4465.  
  4466.  
  4467. saveData:
  4468. ARG messflag .
  4469. IF data.5='' THEN RETURN
  4470. SAY 'Updating...             'lineup||CR
  4471. SIGNAL OFF BREAK_E
  4472. Status Trans
  4473. data.6=STRIP(RESULT)
  4474. IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
  4475. ELSE IF lastbrowse>0 THEN
  4476.   DO
  4477.     IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
  4478.     ELSE data.16=DATE('S') TIME()
  4479.     data.16=lastbrowse data.16
  4480.   END
  4481. IF messflag THEN
  4482.   DO
  4483.     userexclude.=0
  4484.     DO si=1 TO WORDS(data.22)
  4485.       IF WORD(data.22,si)=-1 THEN userexclude.si=1
  4486.     END
  4487.     data.22=''
  4488.     data.23=''
  4489.     DO si=1 TO level
  4490.       IF ~DATATYPE(lastread.si,'N') THEN lastread.si=0
  4491.       IF userexclude.si THEN data.22=data.22 '-1'
  4492.       ELSE data.22=data.22 lastread.si
  4493.       IF ~DATATYPE(totwrit.si,'N') THEN totwrit.si=0
  4494.       data.23=data.23 totwrit.si
  4495.     END
  4496.   END
  4497. IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
  4498. IF data.0<24 THEN data.0=24
  4499. DO i=1 TO data.0
  4500.   CALL WRITELN(f,data.i)
  4501. END
  4502. CALL CLOSE(f)
  4503. SAY 'User' name 'has been updated.'CR
  4504. RETURN
  4505.  
  4506.  
  4507. loadData:
  4508. IF name='' THEN RETURN 0
  4509. IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
  4510. data.=''
  4511. DO i=1
  4512.   line=READLN(f)
  4513.   IF EOF(f) THEN BREAK
  4514.   data.i=line
  4515. END
  4516. data.0=i-1
  4517. CALL CLOSE(f)
  4518. winnings=WORD(data.18,1)
  4519. IF ~DATATYPE(winnings,'N') THEN winnings=0
  4520.  
  4521. setData:
  4522. IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
  4523. lastbrowse=WORD(data.16,1)
  4524. level=data.20
  4525. DO i=1 TO level
  4526.   lastread.i=WORD(data.22,i)
  4527.   IF ~DATATYPE(lastread.i,'N') THEN lastread.i=0
  4528.   totwrit.i=WORD(data.23,i)
  4529.   IF ~DATATYPE(totwrit.i,'N') THEN totwrit.i=0
  4530. END
  4531. password=data.5
  4532. IF data.6='' THEN
  4533.   DO
  4534.     Status Trans
  4535.     data.6=RESULT
  4536.   END
  4537. ELSE
  4538.   DO
  4539.     IF RIGHT(UPPER(data.6),2)='-G' THEN data.6='G'
  4540.     IF RIGHT(UPPER(data.6),3)='-1K' THEN data.6='K'
  4541.     IF LEFT(UPPER(data.6),1)='A' THEN data.6='Z'
  4542.     Set UPPER(LEFT(data.6,1))
  4543.   END
  4544. linesperpage=data.7
  4545. IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
  4546. ELSE terseflag=0
  4547. IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
  4548. ELSE colorflag=0
  4549. CALL colors(colorflag)
  4550. menu='ALL'
  4551. IF FIND(UPPER(data.8),'MENUS')>0 THEN
  4552.   DO
  4553.     menuflag=1
  4554.     menu='MAIN'
  4555.   END
  4556. ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
  4557. ELSE menuflag=0
  4558. IF level=0 THEN menu='NEW'
  4559. data.21=UPPER(data.21)
  4560. maxtime=WORD(data.11,1)*60
  4561. RETURN 1
  4562.  
  4563.  
  4564. switchmenuflag:
  4565. IF menuflag=1 THEN
  4566.   DO
  4567.     menuflag=0
  4568.     noff='OFF'
  4569.   END
  4570. ELSE
  4571.   DO
  4572.     menuflag=1
  4573.     noff='ON'
  4574.   END
  4575. SAY 'Menus turned' pen3||noff||def'.'CR
  4576. SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR
  4577. RETURN
  4578.  
  4579.  
  4580. switchcolors:
  4581. IF colorflag=1 THEN
  4582.   DO
  4583.     colorflag=0
  4584.     noff='OFF'
  4585.   END
  4586. ELSE
  4587.   DO
  4588.     colorflag=1
  4589.     noff='ON'
  4590.   END
  4591. CALL colors(colorflag)
  4592. SAY 'Color turned' pen3||noff||def'.'CR
  4593. SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR
  4594. RETURN
  4595.  
  4596.  
  4597. /* ANSI pen color codes */
  4598. colors:
  4599. ARG onoff
  4600. IF onoff THEN
  4601.   DO
  4602.     lineup='1B'x'M'
  4603.     def='';  /* default */
  4604.     pen0='';  pen1='';  pen2='';  pen3=''
  4605.     pen4='';  pen5='';  pen6='';  pen7=''
  4606.     bak0='';  bak1='';  bak2='';  bak3=''
  4607.     bak4='';  bak5='';  bak6='';  bak7=''
  4608.   END
  4609. ELSE
  4610.   DO
  4611.     pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
  4612.     bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
  4613.     def='';  lineup=''
  4614.   END
  4615. RETURN
  4616.  
  4617.  
  4618. chpro:
  4619. arg=UPPER(LEFT(arg,1))
  4620. IF(arg='') THEN
  4621.   DO
  4622.     SAY CR
  4623.     SAY '['pen3'W'def']- WXModem'CR
  4624.     SAY '['pen3'X'def']- XModem-CRC'CR
  4625.     SAY '['pen3'K'def']- XModem-1K'CR
  4626.     SAY '['pen3'Y'def']- YModem'CR
  4627.     SAY '['pen3'G'def']- YModem-G'CR
  4628.     SAY '['pen3'Z'def']- ZModem'CR
  4629. /* IF RIGHT(BB_VERS,4)>1.59 THEN SAY '['pen3'R'def']- Kermit'CR */
  4630.     SAY CR
  4631.     arg=getinput(1 0 STRIP(protocol) '> ')
  4632.  END
  4633. IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
  4634. Set arg
  4635. Status Transfer
  4636. protocol=STRIP(RESULT)
  4637. SAY protocol||CR
  4638. RETURN
  4639.  
  4640.  
  4641. sortinfofiles:
  4642. infolist=SHOWDIR(bbspath'Information')
  4643. IF infolist='' THEN
  4644.   DO
  4645.     SAY CR
  4646.     SAY pen3'No files are currently in the Information drawer.'def||CR
  4647.     SAY CR
  4648.     RETURN 1
  4649.   END
  4650. IF ~DATATYPE(sortinfo.0,'N') THEN
  4651.   DO
  4652.     info.=''
  4653.     sortinfo.=''
  4654.     info.0=WORDS(infolist)
  4655.     DO i=1 TO info.0
  4656.       info.i=WORD(infolist,i)
  4657.     END
  4658.     SAY 'Sorting..'CR
  4659.     CALL QSORT(1,info.0,info)
  4660.     sortinfo.0=info.0%3
  4661.     IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
  4662.     DO i=1 TO sortinfo.0
  4663.       sortinfo.i=''
  4664.       DO j=0 TO 2
  4665.         k=i+j*sortinfo.0
  4666.         IF k<=info.0 THEN
  4667.           DO
  4668.             sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
  4669.             infocount=WORD(STATEF(bbspath'Information/'info.k),8)
  4670.             sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
  4671.           END
  4672.       END
  4673.     END
  4674.     SAY lineup'         'lineup||CR
  4675.   END
  4676. RETURN 0
  4677.  
  4678.  
  4679. information:
  4680. IF sortinfofiles() THEN RETURN
  4681. SAY pen3'These text files are available for reading online...'def||CR
  4682. num=1
  4683. readcount=-1
  4684. DO infoloop=1
  4685.   IF num=0 THEN
  4686.     DO
  4687.       IF readcount~=-1 THEN
  4688.         DO
  4689.           sortinfo.0=''
  4690.           IF sortinfofiles() THEN RETURN
  4691.         END
  4692.       SAY CENTER('- Number of accesses per file -',75)||CR
  4693.     END
  4694.   SAY pen3||LEFT('-',75,'-')||def||CR
  4695.   IF num=0 THEN
  4696.     DO i=1 TO sortinfo.0
  4697.       SAY sortinfo.i.0||CR
  4698.     END
  4699.   ELSE
  4700.     DO i=1 TO sortinfo.0
  4701.       SAY sortinfo.i||CR
  4702.     END
  4703.   CALL checktime()
  4704.   IF num=0 THEN
  4705.     DO
  4706.       CALL waiting()
  4707.       num=1
  4708.       ITERATE infoloop
  4709.     END
  4710.   num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
  4711.   IF num=0 THEN ITERATE infoloop
  4712.   IF ~DATATYPE(num,'N') | num<1 | num>info.0 THEN RETURN
  4713.   readcount=STATEF(bbspath'Information/'info.num)
  4714.   readbytes=WORD(readcount,2)
  4715.   readcount=WORD(readcount,8)
  4716.   IF ~DATATYPE(readcount,'N') THEN readcount=0
  4717.   SAY '  'info.num 'is' readbytes 'bytes.'CR
  4718.   SAY 'Loading File...'CR
  4719.   ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1
  4720.   CALL readlines(bbspath'Information/'info.num 1)
  4721.   CALL cleanline(0)
  4722.   SAY lineup'    'lynes.0 'lines.'CR
  4723.   SAY CR    
  4724.   CALL seelines(0)
  4725.   CALL showtime()
  4726.   IF waitchar~='Q' THEN CALL waiting()
  4727.   nonstop=0
  4728. END
  4729. RETURN
  4730.  
  4731.  
  4732. newfiles:
  4733. SAY CR
  4734. test=''
  4735. test=getinput(1 1 'Show one library only? (Ny) > ')
  4736. IF test='Y' THEN
  4737.   IF chdir()>0 THEN RETURN
  4738. SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR
  4739. lastbrowz=WORD(data.16,1)
  4740. lastfileup=countcheck(bbspath'Numbers/LastFile' 0)
  4741. IF lastbrowz=lastfileup THEN
  4742.   DO
  4743.     lastbrowz=0
  4744.     SAY pen3'No new files. Listing backwards by date from last file uploaded...'def||CR
  4745.   END
  4746. ELSE newfilesflag=1
  4747. j=0
  4748. IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
  4749. DO ni=lastfileup TO lastbrowz+1 BY -1
  4750.   IF files.ni~='' THEN
  4751.     DO
  4752.       IF test='Y' THEN 
  4753.         DO
  4754.           IF j>=filecount THEN LEAVE ni
  4755.           IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
  4756.             ITERATE ni
  4757.         END
  4758.       jj=files.ni.0
  4759.       IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
  4760.         ITERATE ni  /* unauthorized */
  4761.       j=j+1
  4762.       IF j=1 THEN CALL fileheader()
  4763.       SAY alpha.jj||CR
  4764.       IF (j+2)//(linesperpage-1)=0 THEN
  4765.         IF waiting2() THEN LEAVE ni
  4766.     END
  4767. END
  4768. IF j//linesperpage~=0 THEN CALL waiting()
  4769. IF test~='Y' THEN
  4770.   DO
  4771.     CALL newinfo()
  4772.     IF lynes.0>0 THEN CALL waiting()
  4773.   END
  4774. nonstop=0
  4775. RETURN
  4776.  
  4777.  
  4778. newinfo:
  4779. lynes.=''
  4780. lynes.0=0
  4781. dm=DATE(,WORD(data.16,2),'S')
  4782. PARSE VAR dm da' 'mo' 'yr .
  4783. yr=RIGHT(yr,2)
  4784. sincedate=da'-'mo'-'yr
  4785. startline=1
  4786. arg=bbspath'Information'
  4787. IF WORD(STATEF(arg),5)>lastondate THEN
  4788.   DO
  4789.     ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
  4790.     IF WORD(STATEF('ram:dirlist'),2)>3 THEN
  4791.       DO
  4792.         lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
  4793.         CALL readlines('ram:dirlist' startline+1)
  4794.       END
  4795.   END
  4796. arg=bbspath'Profiles'
  4797. IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  4798.   DO
  4799.     startline=lynes.0+1
  4800.     ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
  4801.     IF WORD(STATEF('ram:dirlist'),2)>3 THEN
  4802.       DO
  4803.         startline=lynes.0+2
  4804.         lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
  4805.         CALL readlines('ram:dirlist' startline+1)
  4806.       END
  4807.   END
  4808. arg=bbspath'rexxDoors/Data/Polls'
  4809. IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  4810.   DO
  4811.     startline=lynes.0+2
  4812.     lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
  4813.     lynes.0=startline
  4814.   END
  4815. IF logonflag=1 THEN nonstop=1
  4816. IF lynes.0>0 THEN CALL seelines(1)
  4817. nonstop=0
  4818. RETURN
  4819.  
  4820.  
  4821. areaselect:
  4822. SAY pen3||LEFT('-',75,'-')||def||CR
  4823. DO i=1 TO msgs.0
  4824.   SAY msgs.i||CR
  4825.   IF i//linesperpage=0 THEN CALL waiting()
  4826. END
  4827. temp=getinput(1 0 pen3'Select Message Conference: 'def)
  4828. IF ~DATATYPE(temp,'N') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
  4829. msgdir=temp
  4830. RETURN 0
  4831.  
  4832.  
  4833. chdir:
  4834. string=''
  4835. SAY pen3||LEFT('-',75,'-')||def||CR
  4836. DO i=1 TO libs.0
  4837.   SAY libs.i||CR
  4838. END
  4839. dirnum=getinput(1 0 pen3'Select Library Number: 'def)
  4840. IF ~DATATYPE(dirnum,'N') THEN
  4841.   DO
  4842.     waitchar=dirnum
  4843.     RETURN 2
  4844.   END
  4845.  
  4846. chdir2:
  4847. IF dirnum<1 | dirnum>99 THEN
  4848.   DO
  4849.     waitchar=dirnum
  4850.     RETURN 1
  4851.   END
  4852. IF dirs.dirnum='' THEN
  4853.   DO
  4854.     SAY pen3'That library number is currently un-assigned.'def||CR
  4855.     RETURN 1
  4856.   END
  4857. IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  4858.   DO
  4859.     SAY pen3'You do not have authorization for that library!'def||CR
  4860.     RETURN 1
  4861.   END
  4862. IF dirs.dirnum~='' THEN
  4863.   DO
  4864.     CALL MAKEDIR(libpath||dirs.dirnum)
  4865.     CALL setdir(libpath||dirs.dirnum)
  4866.   END
  4867. RETURN 0
  4868.  
  4869.  
  4870. since:
  4871. dm=DATE(,WORD(data.16,2),'S')
  4872. SAY CR
  4873. SAY 'New files or files moved since' dm||CR
  4874. CALL listsince()
  4875. CALL readlines('RAM:dirlist' 1)
  4876. CALL seelines(1)
  4877. nonstop=0
  4878. CALL waiting()
  4879. RETURN
  4880.  
  4881.  
  4882. listsince:
  4883. dm=DATE(,WORD(data.16,2),'S')
  4884. PARSE VAR dm da' 'mo' 'yr .
  4885. yr=RIGHT(yr,2)
  4886. sincedate=da'-'mo'-'yr
  4887. ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES SINCE' sincedate
  4888. RETURN
  4889.  
  4890.  
  4891. list:
  4892. onetime=0
  4893. IF DATATYPE(arg,'N') THEN onetime=1
  4894. ELSE arg=''
  4895. DO listloop=1
  4896.   IF DATATYPE(arg,'N') THEN
  4897.     DO
  4898.       dirnum=arg
  4899.       arg=''
  4900.       IF chdir2()>0 THEN RETURN
  4901.       CALL listsimple()
  4902.       IF waitchar='Q' THEN RETURN
  4903.       IF onetime THEN LEAVE listloop
  4904.     END
  4905.   ELSE IF arg='' THEN
  4906.     DO
  4907.       IF chdir()>0 THEN RETURN
  4908.       test='Y'
  4909.       CALL showalpha2()
  4910.       arg=''
  4911.       ITERATE listloop
  4912.     END
  4913.   ELSE RETURN
  4914. END
  4915. RETURN
  4916.  
  4917.  
  4918. listsimple:
  4919. ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES'
  4920. IF readlines('RAM:dirlist' 1) THEN RETURN
  4921. IF lynes.0>3 THEN
  4922.   DO
  4923.     SAY pen3'Sorting...'def||lineup||CR
  4924.     linesave=lynes.1  /* these 4 lines put in to leave dir title at top */
  4925.     lynes.1='0'
  4926.     CALL QSORT(1,lynes.0-1,lynes)
  4927.     CALL DELAY(14)
  4928.     lynes.1=linesave
  4929.   END
  4930. CALL seelines(1)
  4931. nonstop=0
  4932. CALL waiting()
  4933. RETURN
  4934.  
  4935.  
  4936. browse:
  4937. curdironly=0
  4938. brdir=PRAGMA('D')
  4939. brfilenum=1
  4940. nonstop=0
  4941. IF files.0<1 THEN RETURN
  4942. lastfilenum=countcheck(bbspath'Numbers/LastFile' 0)
  4943. IF lastfilenum<1 THEN RETURN
  4944. IF arg='' THEN
  4945.   DO
  4946.     test=getinput(1 1 '['pen3'R'def']ead descriptions or ['pen3'A'def']rchive for later download. (aR) > ')
  4947.     IF test='A' THEN
  4948.       DO
  4949.         IF STORAGE()<(bbsprefs.15+100000) THEN
  4950.           DO
  4951.             SAY CR
  4952.             SAY 'Sorry! Not enough memory left for background archiving.'CR
  4953.             SAY 'Please try again in 10 minutes or so.'CR
  4954.             SAY CR
  4955.             RETURN
  4956.           END
  4957.         CALL send2log('Arc: Make_BrowseList.baud')
  4958.         CALL Make_BrowseList.baud(name)
  4959.         IF countcheck(bbspath'Numbers/LastFile' 0)>lastfilenum THEN
  4960.           IF emailonline>=0 THEN emailonline=emailonline+1
  4961.         RETURN
  4962.       END
  4963.     line='Browsing'
  4964.     test=getinput(1 1 'Browse one library only? (Ny) > ')
  4965.     IF test='Y' THEN
  4966.       DO
  4967.         IF chdir()>0 THEN RETURN
  4968.         curdironly=1
  4969.         line=line 'the' pen3||plaindir||def 'library'
  4970.       END
  4971.     ELSE line=line 'all file libraries'
  4972.     line=line 'backwards from latest file.'
  4973.     SAY line||CR
  4974.   END
  4975. i=0
  4976. IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
  4977.   DO lastfileloop=1
  4978.     IF lastfilenum<1 THEN RETURN
  4979.     arg=WORD(files.lastfilenum,2)
  4980.     brfilenum=lastfilenum
  4981.     IF WORD(files.lastfilenum,2)~='' THEN LEAVE lastfileloop
  4982.     lastfilenum=lastfilenum-1
  4983.   END
  4984. ELSE IF DATATYPE(arg,'N') & files.arg~='' THEN
  4985.   DO
  4986.     brfilenum=arg
  4987.     arg=WORD(files.arg,2)
  4988.   END
  4989. ELSE
  4990.   DO
  4991.     DO i=1 TO lastfilenum+1
  4992.       IF UPPER(WORD(files.i,2))~=UPPER(arg) THEN ITERATE i
  4993.       brfilenum=i
  4994.       LEAVE i
  4995.     END
  4996.     IF i>lastfilenum THEN
  4997.       DO
  4998.         SAY 'Unable to find a file description for' pen3||arg||def'.'CR
  4999.         RETURN
  5000.       END
  5001.   END
  5002. IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
  5003. savearg=arg
  5004. IF brfilenum>lastfilenum THEN brfilenum=lastfilenum
  5005. newfilesdate=DATE('S') TIME()
  5006. DO browseloop=1
  5007.   DO i=brfilenum TO 0 BY -1
  5008.     IF files.i='' THEN ITERATE i
  5009.     testdir=UPPER(WORD(files.i,1))
  5010.     IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
  5011.       DO
  5012.         IF i>lastbrowse THEN lastbrowse=i
  5013.         ITERATE i
  5014.       END
  5015.     IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
  5016.       DO
  5017.         IF i>lastbrowse THEN lastbrowse=i
  5018.         ITERATE i
  5019.       END
  5020.     LEAVE i
  5021.   END
  5022.   IF i=0 THEN brfilenum=lastbrowse
  5023.   ELSE brfilenum=i
  5024.   argname=WORD(files.brfilenum,2)
  5025.   IF argname='' THEN RETURN
  5026.   CALL setdir(libpath||WORD(files.brfilenum,1))
  5027.   arg=bbspath'FileNotes/'plaindir'/'argname
  5028.   CALL readlines(arg 1)
  5029.   IF nonstop=1 THEN brostop=1
  5030.   ELSE brostop=0
  5031.   CALL seelines(1)
  5032.   IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
  5033.   CALL checktime()
  5034.   IF brostop THEN
  5035.     DO
  5036.       SAY CR
  5037.       nonstop=1
  5038.       brfilenum=brfilenum-1
  5039.     END
  5040.   ELSE
  5041.     DO
  5042.       line=''
  5043.       endtest=UPPER(RIGHT(argname,4))
  5044.       IF FIND('.ARC .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN
  5045.         line='['pen3'C'def']ontents ['pen3'D'def']ownload'
  5046.       ELSE line='['pen3'D'def']ownload'
  5047.       IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  5048.         line=line '['pen3'E'def']dit'
  5049.       IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  5050.         line=line '['pen3'K'def']ill'
  5051.       IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
  5052.       line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
  5053.       IF endtest='.TXT' THEN line=line '['pen3'R'def']ead'
  5054.       line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
  5055.       brcom=getinput(1 0 line)
  5056.       IF DATATYPE(brcom,'N') THEN
  5057.         DO
  5058.           brfilenum=brcom+1
  5059.           IF brfilenum>lastfilenum THEN brfilenum=lastfilenum+1
  5060.           IF brfilenum<1 THEN brfilenum=1
  5061.           SAY CR
  5062.         END
  5063.       ELSE brcom=LEFT(brcom,1)
  5064.       CALL cleanline(0)
  5065.       IF brcom='Q' THEN LEAVE browseloop
  5066.       IF brcom='M' THEN
  5067.         DO
  5068.           wordnum=FIND(data.25,brfilenum)
  5069.           IF wordnum=0 THEN
  5070.             DO
  5071.               data.25=STRIP(data.25 brfilenum)
  5072.               SAY lineup||argname 'marked for next download.'CR
  5073.               SAY CR
  5074.             END
  5075.           ELSE
  5076.             DO
  5077.               data.25=STRIP(DELWORD(data.25,wordnum,1))
  5078.               SAY argname 'removed from download list.'CR
  5079.             END
  5080.         END
  5081.       IF brcom='H' | brcom='?' THEN
  5082.         DO
  5083.           SAY pen3' - HELP with the Browse Files commands -'def||CR
  5084.           SAY ' RETURN reads the next file description in line.'CR
  5085.           SAY ' 34 will display the description of file number 34, if it exists.'CR
  5086.           SAY ' C  displays the contents of an archived (arc dms lzh lha zip zoo) file.'CR
  5087.           SAY ' D  displays the download menu.'CR
  5088.           IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  5089.             DO
  5090.           SAY ' E  puts this file description into the online Editor.'CR
  5091.           SAY ' K  deletes a file you uploaded. you cannot Kill others!'CR
  5092.             END
  5093.           IF level>sysoplevel THEN
  5094.           SAY ' L  move file and description to new Library and/or rename.'CR
  5095.           SAY ' M  mark/unmark the current file for the next download'CR
  5096.           SAY ' N  displays all descriptions without pausing. CTRL-E to Exit!'CR
  5097.           SAY ' R  displays file as text. - ONLY FILES THAT END IN .TXT -'CR
  5098.           SAY ' Q  returns to the main menu(s). (Quit)'CR
  5099.           SAY CR
  5100.           CALL waiting()
  5101.           IF waitchar='Q' THEN LEAVE browseloop
  5102.         END
  5103.       ELSE IF brcom='L' & level>sysoplevel THEN
  5104.         DO
  5105.           curdir=PRAGMA('D')
  5106.           IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
  5107.             DO
  5108.               newarg=getinput(0 0 'Rename' argname 'to ')
  5109.               IF newarg~='' THEN
  5110.                 DO
  5111.                   junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
  5112.                   IF junk='Y' THEN
  5113.                     DO
  5114.                       lynes.2=OVERLAY(newarg,lynes.2,7,25)
  5115.                       comment=WORD(STATEF(libpath||filedir'/'arg),8)
  5116.                       CALL DELETE(arg)
  5117.                       CALL savelines(arg)
  5118.                       mpath=bbspath'FileNotes/'plaindir
  5119.                       CALL RENAME(mpath'/'argname,mpath'/'newarg)
  5120.                       IF comment~='' THEN
  5121.                         ADDRESS COMMAND 'C:FileNote' mpath'/'newarg comment
  5122.                       mpath=libpath||plaindir
  5123.                       CALL RENAME(mpath'/'argname,mpath'/'newarg)
  5124.                       files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
  5125.                       anum=files.brfilenum.0
  5126.                       alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
  5127.                       CALL send2log('RENAME:' argname 'to' newarg 'in' plaindir)
  5128.                       argname=newarg
  5129.                       sortalphaflag=1
  5130.                       savefileflag=1
  5131.                     END
  5132.                 END
  5133.             END
  5134.           mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ')
  5135.           IF mvdir~='' THEN
  5136.             DO
  5137.               IF DATATYPE(mvdir,'N') THEN
  5138.                 DO
  5139.                   dirnum=mvdir
  5140.                   IF chdir2()=0 THEN
  5141.                     CALL movefile(brfilenum dirs.dirnum)
  5142.                 END
  5143.               ELSE
  5144.                 DO
  5145.                   mvdir=STRIP(mvdir)
  5146.                   DO mj=1 TO level+1
  5147.                     IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj
  5148.                   END
  5149.                   IF mj<=level THEN CALL movefile(brfilenum mvdir)
  5150.                 END
  5151.             END
  5152.           IF savefileflag>0 THEN CALL savefilelist()
  5153.           CALL setdir(curdir)
  5154.         END
  5155.       ELSE IF brcom='N' THEN
  5156.         DO
  5157.           brfilenum=brfilenum-1
  5158.           nonstop=1
  5159.           SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR
  5160.           SAY CR
  5161.           CALL DELAY(100)
  5162.           brcom=''
  5163.         END
  5164.       ELSE IF brcom='C' THEN
  5165.         DO
  5166.           temp=STRIP(WORD(STATEF(arg),8))
  5167.           IF temp='' THEN temp=libpath||plaindir'/'argname
  5168.           CALL Contents.rexx(temp)
  5169.           IF EXISTS('RAM:CONTENTS') THEN
  5170.             DO
  5171.               CALL cleanline(1)
  5172.               CALL readlines('RAM:CONTENTS' 1)
  5173.               CALL seelines(0)
  5174.               IF waitchar~='Q' THEN CALL waiting()
  5175.               nonstop=0
  5176.             END
  5177.           ELSE SAY pen3'Not an archived file.'def||CR
  5178.         END
  5179.       ELSE IF brcom='D' THEN
  5180.         DO
  5181.           arg2=arg
  5182.           arg=argname
  5183.           CALL dload()
  5184.           arg=arg2
  5185.         END
  5186.       ELSE IF brcom='E' THEN
  5187.         DO
  5188.           IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  5189.             DO
  5190.               firstedit=5
  5191.               IF level>sysoplevel THEN firstedit=1
  5192.               CALL bbsED(firstedit arg)
  5193.             END
  5194.         END
  5195.       ELSE IF brcom='K' THEN
  5196.         DO
  5197.           IF level>sysoplevel | name=WORD(lynes.3,2) THEN
  5198.             DO
  5199.               IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
  5200.                 DO
  5201.                   tempnum=WORD(lynes.1,2)
  5202.                   IF tempnum=lastfilenum THEN
  5203.                     DO
  5204.                       CALL DELETE(bbspath'Numbers/LastFile')
  5205.                       CALL DELAY(28)
  5206.                       lastfilenum=lastfilenum-1
  5207.                       CALL countcheck(bbspath'Numbers/LastFile' lastfilenum)
  5208.                     END
  5209.                   files.tempnum=''
  5210.                   tempnum2=files.tempnum.0
  5211.                   alpha.tempnum2='0 0' tempnum '100'
  5212.                   IF SHOW('P','BBBBS_LOCAL') THEN CALL savefilelist()
  5213.                   ELSE savefileflag=1
  5214.                   CALL DELETE(argname)
  5215.                   CALL DELETE(arg)
  5216.                   CALL send2log('Killed:' argname)
  5217.                   SAY argname pen3'has been deleted.'def||CR
  5218.                 END
  5219.             END
  5220.         END
  5221.       ELSE IF brcom='R' & endtest='.TXT' THEN
  5222.         DO
  5223.           vcount=WORD(lynes.2,7)+1
  5224.           lynes.2=STRIP(DELWORD(lynes.2,7)) vcount
  5225.           edtype=''
  5226.           CALL savelines(arg)
  5227.           CALL showtext(argname)
  5228.         END
  5229.       ELSE brfilenum=brfilenum-1
  5230.     END
  5231. END
  5232. CALL setdir(brdir)
  5233. waitchar=''
  5234. IF nonstop THEN CALL waiting()
  5235. nonstop=0
  5236. CALL savedata(0)
  5237. RETURN
  5238.  
  5239.  
  5240. movefile:
  5241. PARSE ARG fnum movdir .
  5242. fromdir=STRIP(WORD(files.fnum,1))
  5243. farg=STRIP(WORD(files.fnum,2))
  5244. CALL MAKEDIR(libpath||movdir)
  5245. ADDRESS COMMAND 'C:COPY' libpath||fromdir'/'farg libpath||movdir
  5246. IF EXISTS(libpath||movdir'/'farg) THEN CALL DELETE(libpath||fromdir'/'farg)
  5247. files.fnum=movdir farg
  5248. lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
  5249. lynes.3=STRIP(lynes.3) movdir
  5250. CALL MAKEDIR(bbspath'FileNotes/'movdir)
  5251. CALL savelines(bbspath'FileNotes/'movdir'/'farg)
  5252. ndx=files.fnum.0
  5253. dnum=finddirnum(movdir)
  5254. alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
  5255. IF EXISTS(bbspath'FileNotes/'movdir'/'farg) THEN
  5256.   CALL DELETE(bbspath'FileNotes/'fromdir'/'farg)
  5257. savefileflag=1
  5258. line='Moved:' fromdir'/'farg 'to' movdir
  5259. CALL send2log(line)
  5260. SAY line||CR
  5261. RETURN
  5262.  
  5263.  
  5264. textsearch:
  5265. PARSE ARG sfile' 'sarg
  5266. IF sarg='' THEN RETURN 0
  5267. x=OPEN(f,sfile,'R')
  5268. IF x=0 THEN RETURN 0
  5269. sarg=UPPER(sarg)
  5270. stemp=UPPER(READCH(f,65000))
  5271. CALL CLOSE(f)
  5272. retflag=0
  5273. IF POS(sarg,stemp)>0 THEN retflag=1
  5274. DROP stemp
  5275. RETURN retflag
  5276.  
  5277.  
  5278. bbsSEARCH:
  5279. smenu=menu
  5280. test=UPPER(LEFT(arg,1))
  5281. IF test='F' THEN smenu='FILE'
  5282. IF test='M' THEN smenu='MSG'
  5283. IF test='U' THEN smenu='MAIN'
  5284. IF smenu='ALL' THEN
  5285.   DO
  5286.     junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
  5287.     IF junk='F' THEN smenu='FILE'
  5288.     ELSE IF junk='M' THEN smenu='MSG'
  5289.     ELSE IF junk='U' THEN smenu='MAIN'
  5290.     ELSE RETURN
  5291.   END
  5292. IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
  5293. ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
  5294. IF LENGTH(STRIP(searcharg))=0 THEN RETURN
  5295. searcharg=COMPRESS(searcharg,'*')
  5296. CALL send2log('SEARCH:' smenu 'for' searcharg)
  5297. IF smenu='NEW' | smenu='MAIN' THEN
  5298.   DO
  5299.     SAY 'Searching Userlist...'CR
  5300.     DO i=1 TO WORDS(userlist)
  5301.       IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN
  5302.         SAY WORD(userlist,i)||CR
  5303.     END
  5304.   END
  5305. IF smenu='MSG' THEN
  5306.   DO
  5307.     SAY 'Searching Message Conferences for'pen3 searcharg||def'...'CR
  5308.     SAY CR
  5309.     DO msgdir=1 TO level
  5310.       IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE msgdir
  5311.       CALL searchmsgdir()
  5312.       IF msgcom='Q' THEN LEAVE msgdir
  5313.     END
  5314.   END
  5315. IF smenu='FILE' THEN
  5316.   DO
  5317.     SAY pen3'WARNING!'def 'Searching' files.0 '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR
  5318.     test=getinput(1 1 ' ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
  5319.     IF test='Q' THEN RETURN
  5320.     IF test~='F' THEN
  5321.       DO
  5322.         SAY CR
  5323.         SAY pen3'Searching files for'def UPPER(searcharg)||CR
  5324.         CALL fileheader()
  5325.         DO i=1 TO alpha.0
  5326.           IF WORD(alpha.i,4)>level THEN ITERATE i
  5327.           ii=WORD(alpha.i,3)
  5328.           IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
  5329.           tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
  5330.           IF tempnum>0 THEN
  5331.             DO
  5332.               SAY alpha.i||CR
  5333.               IF colorflag=1 THEN
  5334.                 SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
  5335.             END
  5336.         END
  5337.       END
  5338.     ELSE
  5339.       DO
  5340.         SAY CR
  5341.         SAY pen3'Searching files for'def UPPER(searcharg)||CR
  5342.         SAY pen3' - To ABORT, press CTRL-E -'def||CR
  5343.         SAY CR
  5344.         cck=countcheck(bbspath'Numbers/LastFile' 0)
  5345.         nonstop=1
  5346.         DO i=1 TO cck
  5347.           iii=cck+1-i
  5348.           IF files.iii='' THEN ITERATE i
  5349.           farg=WORD(files.iii,1)'/'WORD(files.iii,2)
  5350.           ii=files.iii.0
  5351.           IF WORD(alpha.ii,4)>level THEN ITERATE i
  5352.           IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
  5353.           SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)||CR
  5354.           IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
  5355.             DO
  5356.               savei=i
  5357.               CALL readlines(bbspath'FileNotes/'farg 1)
  5358.               CALL seelines(2)
  5359.               i=savei
  5360.               SAY CR
  5361.               SAY CR
  5362.             END
  5363.         END
  5364.       END
  5365.   END
  5366. searcharg=''
  5367. nonstop=0
  5368. CALL waiting()
  5369. RETURN
  5370.  
  5371.  
  5372. searchmsgdir:
  5373. msglist=SHOWDIR(msgpath||msgdir)
  5374. IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)||CR
  5375. DO sri=1 TO WORDS(msglist)
  5376.   messnum=WORD(msglist,sri)%1
  5377.   IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN
  5378.     DO
  5379.       savelast=lastread.msgdir
  5380.       CALL readmsg(0 messnum)
  5381.       lastread.msgdir=savelast
  5382.       IF msgcom='Q' THEN RETURN
  5383.     END
  5384. END
  5385. RETURN
  5386.  
  5387.  
  5388. finddirnum:
  5389. ARG fdirname .
  5390. DO fdir=1 TO 99
  5391.   IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
  5392. END
  5393. RETURN 100
  5394.  
  5395.  
  5396. writebuffer:
  5397. PARSE ARG bufname .
  5398. Capture OFF
  5399. CALL DELETE(bufname)
  5400. SAY 'Type 'pen3'/E'def'nd on a new line to exit.'CR
  5401. IF EXISTS(bufname) THEN
  5402.   DO
  5403.     CALL DELAY(56)
  5404.     CALL DELETE(bufname)
  5405.     CALL DELAY(56)
  5406.   END
  5407. CaptWrap 74
  5408. Send pen3
  5409. Capture bufname
  5410. Send def
  5411. TimeOut 120
  5412. DO bufloop=1
  5413.   Wait '/E,/S,RING,NO CARRIER'
  5414.   Status 'L'
  5415.   test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  5416.   IF test='/E' | test='/S' THEN LEAVE bufloop
  5417.   CALL checkdcd()
  5418. END
  5419. Send '\b\b'pen3
  5420. Capture OFF
  5421. CALL checkdcd()
  5422. TimeOut maxidle
  5423. SAY def||CR
  5424. startnum=lynes.0+1
  5425. CALL readlines(bufname startnum)
  5426. CALL wrapbuf(startnum)
  5427. QUEUE CR
  5428. RETURN
  5429.  
  5430.  
  5431. wrapbuf:
  5432. ARG startnum .
  5433. CALL cleanline(1)
  5434. SAY pen3'Wordwrapping...'def||CR
  5435. lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
  5436. lynes.startnum=cleanstring(2':'lynes.startnum)
  5437. DO wi=startnum WHILE wi<=lynes.0
  5438.   wj=wi+1
  5439.   lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  5440.   lynes.wj=cleanstring(2':'lynes.wj)
  5441.   IF LENGTH(lynes.wi)>75 THEN
  5442.     DO
  5443.       testchar=''
  5444.       IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
  5445.       IF testchar=' ' | testchar='.' | testchar=':' THEN
  5446.         DO
  5447.           DO wjj=lynes.0 TO wi+1 BY -1
  5448.             wk=wjj+1
  5449.             lynes.wk=lynes.wjj
  5450.           END
  5451.           lynes.wj=''
  5452.           lynes.0=lynes.0+1
  5453.         END
  5454.       DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
  5455.         IF WORDS(lynes.wi)=1 THEN
  5456.           lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
  5457.         lynes.wj=WORD(lynes.wi,wl) lynes.wj
  5458.         lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
  5459.       END
  5460.     END
  5461. END
  5462. RETURN
  5463.  
  5464.  
  5465. seelines:
  5466. ARG fancy .
  5467. DO i=1 TO lynes.0
  5468.   IF fancy=0 THEN SAY lynes.i||def||CR
  5469.   ELSE
  5470.     DO
  5471.       IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
  5472.       ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
  5473.         SAY pen3||lynes.i||def||CR
  5474.       ELSE SAY lynes.i||CR
  5475.       IF fancy=2 & colorflag=1 & searcharg~='' THEN
  5476.         DO
  5477.           testpos=POS(UPPER(searcharg),UPPER(lynes.i))
  5478.           IF testpos>0 THEN
  5479.             SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def||CR
  5480.         END
  5481.     END
  5482.   IF i//linesperpage=0 THEN
  5483.     IF waiting2() THEN LEAVE i
  5484. END
  5485. nonstop=0
  5486. RETURN
  5487.  
  5488.  
  5489. readlines:
  5490. CALL CLOSE(f)
  5491. PARSE ARG tempname readstart .
  5492. IF ~readopen(tempname) THEN RETURN 1
  5493. IF readstart<2 THEN lynes.=''
  5494. DO ri=readstart
  5495.   line=READLN(f)
  5496.   IF EOF(f) THEN BREAK
  5497.   lynes.ri=line
  5498. END
  5499. lynes.0=ri-1
  5500. CALL CLOSE(f)
  5501. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
  5502. END
  5503. lynes.0=ri
  5504. RETURN 0
  5505.  
  5506.  
  5507. savelines:
  5508. PARSE ARG tempname .
  5509. IF EXISTS(tempname) & edtype='MAIL' THEN
  5510.   DO
  5511.     ok=OPEN(f,tempname,'A')
  5512.     IF ok~=0 THEN CALL WRITELN(f,INSERT('','',1,74,'^'))
  5513.   END
  5514. ELSE ok=OPEN(f,tempname,'W')
  5515. IF ok=0 THEN
  5516.   DO
  5517.     line='***' tempname 'failed to open for saving!'
  5518.     CALL send2log(line)
  5519.     SAY line||CR
  5520.     RETURN 1
  5521.   END
  5522. DO wi=1 TO lynes.0
  5523.   CALL WRITELN(f,lynes.wi)
  5524. END
  5525. CALL CLOSE(f)
  5526. RETURN 0
  5527.  
  5528.  
  5529. loaduserlist:
  5530. userlist=SHOWDIR(bbspath'Users')
  5531. ulynes.=''
  5532. IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist()
  5533. ELSE IF readopen(bbspath'Lists/USERS') THEN
  5534.   DO
  5535.     SAY 'Loading Userlist...'CR
  5536.     DO lui=1
  5537.       line=READLN(f)
  5538.       IF EOF(f) THEN BREAK
  5539.       ulynes.lui=line
  5540.     END
  5541.     ulynes.0=lui-1
  5542.     CALL CLOSE(f)
  5543.   END
  5544. RETURN
  5545.  
  5546.  
  5547. saveuserlist:
  5548. SIGNAL OFF BREAK_E
  5549. IF writeopen(bbspath'Lists/USERS') THEN
  5550.   DO
  5551.     DO i=1 TO ulynes.0
  5552.       CALL WRITELN(f,ulynes.i)
  5553.     END
  5554.     CALL CLOSE(f)
  5555.   END
  5556. RETURN
  5557.  
  5558.  
  5559. sortuserlist:
  5560. SAY 'Rebuilding Userlist...'CR
  5561. sortuserflag=0
  5562. userlist=SHOWDIR(bbspath'Users')
  5563. user.=''
  5564. users=WORDS(userlist)
  5565. user.0=users
  5566. DO uli=1 TO users
  5567.   user.uli=WORD(userlist,uli)
  5568.   uscore=LASTPOS('_',user.uli)
  5569.   IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1)
  5570. END
  5571. CALL QSORT(1,users,user)
  5572. DO uli=1 TO users
  5573.   uscore=POS('@',user.uli)
  5574.   IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1)
  5575. END
  5576. ulynes.=''
  5577. ulynes.0=user.0%3
  5578. IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1
  5579. DO i=1 TO ulynes.0
  5580.   ulynes.i=LEFT(user.i,25)
  5581.   DO j=1 TO 2
  5582.     k=i+j*ulynes.0
  5583.     IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25)
  5584.   END
  5585. END
  5586. CALL saveuserlist()
  5587. RETURN
  5588.  
  5589.  
  5590. showuserlist:
  5591. IF data.5='' THEN line='Here are the EMail names of your fellow users.'
  5592. ELSE line='   'WORDS(userlist) 'users. Use these names to address messages.'
  5593. SAY pen3||line||def||CR
  5594. DO uli=1 TO ulynes.0
  5595.   SAY ulynes.uli||CR
  5596.   IF uli//linesperpage=0 & uli<ulynes.0 THEN
  5597.     IF waiting2()=1 THEN RETURN
  5598. END
  5599. IF data.5~='' THEN CALL waiting()
  5600. RETURN
  5601.  
  5602.  
  5603. msgcount:
  5604. ARG countdir .
  5605. lastmess=0
  5606. totmsgs=0
  5607. unred=0
  5608. IF ~EXISTS(msgpath||countdir) THEN RETURN
  5609. IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
  5610. ELSE
  5611.   DO
  5612.     totmsgs=WORDS(SHOWDIR(msgpath||countdir))
  5613.     msg.countdir.0=totmsgs
  5614.     msg.countdir.1=STATEF(msgpath||countdir)
  5615.   END
  5616. IF countdir>level | FIND(data.21,i)>0 THEN RETURN
  5617. lastread.countdir=WORD(data.22,countdir)
  5618. IF ~DATATYPE(lastread.countdir,'N') THEN lastread.countdir=0
  5619. lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0)
  5620. IF lastread.countdir<0 THEN RETURN
  5621. firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0)
  5622. IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
  5623. IF lastmess>0 THEN
  5624.   IF lastread.countdir>=0 THEN
  5625.     DO
  5626.       IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
  5627.       unred=lastmess-lastread.countdir
  5628.       IF unred>totmsgs THEN unred=totmsgs
  5629.       cline=RIGHT(unred,6) 'unread of' RIGHT(lastmess,6)
  5630.       cline=cline 'messages in the 'CENTER(msg.countdir,20)' conference.'
  5631.       IF unred>0 | ~logonflag THEN SAY pen6||cline||def||CR
  5632.     END
  5633. RETURN
  5634.  
  5635.  
  5636. counts:
  5637. SAY CR
  5638. DO i=1 TO 4
  5639.   SAY CENTER(copyright.i,75)||CR
  5640. END
  5641. prevcaller=GETCLIP('BBS_prevcaller')
  5642. IF prevcaller~='' THEN
  5643.   DO
  5644.     SAY CR
  5645.     SAY 'The previous'pen3 bbsname def'user was:'CR
  5646.     SAY ' 'prevcaller||CR
  5647.     SAY '  logged off at:' GETCLIP('BBS_userlogoff')||CR
  5648.     SAY pen3'Last disconnect:'def GETCLIP('BBS_disconnect')||CR
  5649.   END
  5650. SAY CR
  5651. day1='01'
  5652. IF readopen(bbspath'Numbers/FirstLogon') THEN
  5653.   DO
  5654.     line=READLN(f)
  5655.     CALL CLOSE(f)
  5656.     SAY 'The First Logon to'pen3 bbsname def'was' line'.'CR
  5657.     PARSE VAR line .' 'day1'-'.
  5658.   END
  5659. IF day1<10 & LENGTH(day1)<2 THEN day1='0'day1
  5660. SAY '     Your sysop is' pen3||sysop||def||CR
  5661. SAY CR
  5662. usagelist=SHOWDIR(bbspath'Usage','F')
  5663. tempnum=FIND(usagelist,'USER.LOG')
  5664. IF tempnum>0 THEN usagelist=DELWORD(usagelist,tempnum,1)
  5665. usagelist=sortnumbers(usagelist)
  5666. SAY pen3'             - Total BBS Usage -'def||CR
  5667. DO i=1 TO WORDS(usagelist)
  5668.   dateclip=STRIP(WORD(usagelist,i))
  5669.   IF i=1 THEN day1=dateclip||day1
  5670.   usageclip=countcheck(bbspath'Usage/'dateclip 0)
  5671.   usageclp=usageclip%60 usageclip//60
  5672.   mtime=30*23*60  /* we guess 1 hour a day for various maintenance */
  5673.   IF dateclip=LEFT(DATE('S'),6) THEN mtime=RIGHT(DATE('S'),2)*23*60
  5674.   dateclip=dateclip'01'
  5675.   line=RIGHT(DATE('M',dateclip,'S'),10) WORD(DATE(,dateclip,'S'),3)':'
  5676.   line=line RIGHT(WORD(usageclp,1),3) 'hours' RIGHT(WORD(usageclp,2),2)
  5677.   line=line 'minutes  = ' RIGHT(((usageclip*100)/mtime)%1,2) 'percent usage.'
  5678.   SAY line||CR
  5679.   IF (i+12)//(linesperpage-3)=0 THEN
  5680.     IF waiting2() THEN LEAVE i
  5681. END
  5682. cmin=countcheck(bbspath'Numbers/Minutes' 0)
  5683. chr=cmin%60
  5684. cmin=cmin//60
  5685. hrz=chr
  5686. IF hrz<1 THEN hrz=1
  5687. IF day1>19900101 THEN
  5688.   DO
  5689.     hrz=1+DATE('I')-DATE('I',day1,'S')
  5690.     hrz=hrz*24
  5691.   END
  5692. SAY CR
  5693. SAY '     Total Connect Time Since First Logon [all users]:'CR
  5694. SAY RIGHT(chr,20) 'hours' RIGHT(cmin,2) 'minutes  = ' RIGHT(((chr*100)/hrz)%1,2) 'percent usage.'CR
  5695. SAY CR
  5696. CALL waiting2()
  5697. IF waitchar='Q' THEN RETURN
  5698. CALL bbsspace(15)
  5699. SAY RIGHT(comma(countcheck(bbspath'Numbers/Calls' 0)),15) 'completed calls.'CR
  5700. SAY CR
  5701. IF extdevs~='' THEN CALL showxdevs()
  5702. SAY RIGHT(comma(countcheck(bbspath'Numbers/Bytes.DownLoad' 0)),15) 'bytes  in' RIGHT(comma(countcheck(bbspath'Numbers/Files.DownLoad' 0)),7) 'files downloaded.'CR
  5703. SAY CR
  5704. SAY RIGHT(comma(countcheck(bbspath'Numbers/Bytes.UpLoad' 0)),15) 'bytes  in' RIGHT(comma(countcheck(bbspath'Numbers/LastFile' 0)),7) 'files uploaded.'CR
  5705. IF emailonline<0 THEN CALL countmail()
  5706. SAY RIGHT(comma(emailonline),15) 'online of' RIGHT(comma(countcheck(bbspath'Numbers/LastMail' 0)),7) 'private messages.'CR
  5707. SAY RIGHT(comma(grand),15) 'online of' RIGHT(comma(grand2),7) 'public messages.'CR
  5708. SAY RIGHT(comma(files.0),15) 'online of' RIGHT(comma(countcheck(bbspath'Numbers/LastFile' 0)),7) 'public files.'CR
  5709. SAY RIGHT(comma(WORDS(userlist)),15) 'active of' RIGHT(comma(countcheck(bbspath'Numbers/Users' 0)),7) 'user applications.'CR
  5710. SAY CR
  5711. SAY 'Your access level is 'level'  -  minimum sysop level is' sysoplevel||CR
  5712. SAY CR
  5713. SAY '  You Have'CR
  5714. totmail=WORD(data.17,2)
  5715. IF ~DATATYPE(totmail,'N') THEN totmail=0
  5716. totmsg=0
  5717. DO ti=1 TO level
  5718.   temp=WORD(data.23,ti)
  5719.   IF DATATYPE(temp,'N') THEN totmsg=totmsg+WORD(data.23,ti)
  5720. END
  5721. SAY '   Written' RIGHT(comma(totmsg),14)'  public &' RIGHT(comma(totmail),8)'  private messages.'CR
  5722. totfiles=WORD(data.14,1)
  5723. IF ~DATATYPE(totfiles,'N') THEN totfiles=0
  5724. totbytes=WORD(data.14,3)
  5725. IF ~DATATYPE(totbytes,'N') THEN totbytes=0
  5726. SAY '  Uploaded' RIGHT(comma(totbytes),14)'  bytes in' RIGHT(comma(totfiles),8)'  files.'CR
  5727. totfiles=WORD(data.15,1)
  5728. IF ~DATATYPE(totfiles,'N') THEN totfiles=0
  5729. totbytes=WORD(data.15,3)
  5730. IF ~DATATYPE(totbytes,'N') THEN totbytes=0
  5731. SAY 'Downloaded' RIGHT(comma(totbytes),14)'  bytes in' RIGHT(comma(totfiles),8)'  files.'CR
  5732. PARSE VAR data.19 dhour' hours 'dmin' minutes in 'calls .
  5733. IF ~DATATYPE(dhour,'N') THEN dhour=0
  5734. IF ~DATATYPE(dmin,'N') THEN dmin=0
  5735. IF ~DATATYPE(calls,'N') THEN calls=0
  5736. SAY '..and been on' bbsname dhour 'hours' dmin+TIME('E')%60 'minutes in' calls+1 'calls.'CR
  5737. SAY CR
  5738. CALL waiting2()
  5739. IF waitchar='Q' THEN RETURN
  5740. CALL showmarked()
  5741. CALL logonstats()
  5742. nonstop=0
  5743. CALL waiting()
  5744. RETURN
  5745.  
  5746.  
  5747. countmail:
  5748. SAY 'Counting online email...'lineup||CR
  5749. emailonline=0
  5750. DO ti=1 TO WORDS(userlist)
  5751.   emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(userlist,ti)))
  5752. END
  5753. RETURN
  5754.  
  5755.  
  5756. hourly:
  5757. IF level=99 & nonstop~=1 THEN
  5758.   DO
  5759.     IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
  5760.       ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
  5761.     CALL cleanline(1)
  5762.   END
  5763. hc.=0
  5764. hc.24=countcheck(bbspath'Numbers/Hourly/Start' 0)
  5765. IF hc.24=0 THEN hc.25=1
  5766. ELSE hc.25=1+DATE('I')-hc.24
  5767. hc.26=countcheck(bbspath'Numbers/Hourly/Hour' 0)
  5768. hc.27=TIME('H')
  5769. DO i=0 TO 23
  5770.   temp=hc.25
  5771.   IF temp>1 & i>hc.27 THEN temp=temp-1
  5772.   hc.i=countcheck(bbspath'Numbers/Hourly/'i 0)%temp
  5773. END
  5774. IF hc.24=0 THEN hc.24=DATE('I')
  5775. SAY CR
  5776. SAY pen3'        Average minutes per hour of use each day since' DATE(,hc.24,'I')||def||CR
  5777. line=' Hour:  ********10********20********30********40********50********60'
  5778. SAY line||CR
  5779. DO i=0 TO 23
  5780.   IF i=0 THEN temp=12'am'
  5781.   ELSE IF i<12 THEN temp=i'am'
  5782.   ELSE IF i=12 THEN temp='12pm'
  5783.   ELSE temp=i-12'pm'
  5784.   SAY RIGHT(temp,5)':  'pen3||LEFT('*',hc.i,'*')||def||CR
  5785.   IF i=(linesperpage-4) THEN CALL waiting2()
  5786. END
  5787. SAY line||CR
  5788. DROP hc.
  5789. RETURN
  5790.  
  5791.  
  5792. logonstats:
  5793. IF level=0 THEN RETURN
  5794. SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime||CR
  5795. tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse
  5796. IF tempnum>files.0 THEN tempnum=files.0
  5797. line='of' RIGHT(countcheck(bbspath'Numbers/LastFile' 0),6) 'public files uploaded.'CR
  5798. IF tempnum>0 THEN SAY RIGHT(tempnum,6) '   new of' RIGHT(files.0,6) 'files online    'line
  5799. ELSE SAY '       No new' line
  5800. totmsg=0
  5801. grand=0
  5802. grand2=0
  5803. DO i=1 TO 99
  5804.   IF msg.i='' THEN ITERATE i
  5805.   CALL msgcount(i)
  5806.   totmsg=totmsg+unred
  5807.   grand=grand+totmsgs
  5808.   grand2=grand2+lastmess
  5809. END
  5810. line=RIGHT(grand2,6) 'public messages written'
  5811. IF totmsg>0 THEN
  5812.   SAY RIGHT(totmsg,6) '   new of' line',' grand 'messages still online.'CR
  5813. ELSE SAY '       No new of' line'.'CR
  5814. IF level>sysoplevel THEN
  5815.   DO
  5816.     IF GETCLIP('BBS_screen')~=0 THEN
  5817.          SAY pen3' - BB screen is ON -'def||CR
  5818.     ELSE SAY pen3' - BB screen is OFF -'def||CR
  5819.   END
  5820.  
  5821. callsleft:
  5822. test=WORD(data.11,3)
  5823. IF test<1 THEN
  5824.   line=pen0||bak1' Attention! 'def 'This is your last call for' DATE('W')',' DATE()
  5825. ELSE
  5826.   DO
  5827.     line='You may call' test 'more time'
  5828.     IF test~=1 THEN line=line's'
  5829.     line=line 'today.'
  5830.   END
  5831. SAY line||CR
  5832. RETURN
  5833.  
  5834.  
  5835. checkdcd:
  5836. IF GETCLIP('BBS_interpret')='' THEN
  5837.   DO
  5838.     dcd
  5839.     IF RC=0 THEN
  5840.       DO
  5841.         DO dcds=1 TO 3  /* 5 second delay */
  5842.           Beep (bm*20)
  5843.           Beep (bm*16)
  5844.           CALL DELAY(50)
  5845.           dcd
  5846.           IF RC~=0 THEN RETURN
  5847.         END
  5848.         dcd
  5849.         IF RC=0 THEN
  5850.           DO
  5851.             SAY CR
  5852.             Capture OFF
  5853.             Remote OFF
  5854.             CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
  5855.             line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^'
  5856.             SAY line||CR
  5857.             Send '\dATH1\r'
  5858.             CALL send2log(line)
  5859.             CALL sound_badlogoff()
  5860.             IF newpassword='' THEN SIGNAL DONE
  5861.             ELSE SIGNAL OUT
  5862.           END
  5863.       END
  5864.   END
  5865. CALL checkexternal()
  5866. RETURN
  5867.  
  5868.  
  5869. sound_badlogoff:
  5870. SIGNAL OFF BREAK_C
  5871. DO bp=1 TO 28
  5872.   IF RIGHT(BB_VERS,4)>1.59 THEN Beep (100+bp*9)
  5873.   ELSE Beep (800+bp*60)
  5874. END
  5875. RETURN
  5876.  
  5877.  
  5878. checkexternal:
  5879. xmsg=GETCLIP('BBS_MESSAGE')
  5880. Capture
  5881. IF RC=0 & xmsg~='' THEN
  5882.   DO
  5883.     SAY CR
  5884.     SAY bak2' Message From BBBBS: 'def||CR
  5885.     SAY xmsg||CR
  5886.     SAY CR
  5887.     CALL SETCLIP('BBS_MESSAGE')
  5888.   END
  5889. xstring=GETCLIP('BBS_interpret')
  5890. IF xstring~='' THEN
  5891.   DO
  5892.     INTERPRET xstring
  5893.     CALL SETCLIP('BBS_interpret')
  5894.   END
  5895. xcom=GETCLIP('BBS_COMMAND')
  5896. IF xcom~='' THEN
  5897.   DO
  5898.     CALL SETCLIP('BBS_COMMAND')
  5899.     IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2
  5900.     IF opt~='' THEN
  5901.       DO
  5902.         IF POS('M',xcom)>0 THEN CALL validate()
  5903.         IF POS('L',xcom)>0 THEN CALL uplevel()
  5904.         IF POS('T',xcom)>0 THEN CALL uptime()
  5905.         IF POS('R',xcom)>0 THEN CALL upratio()
  5906.       END
  5907.     IF POS('C',xcom)>0 THEN CALL chat()
  5908.   END
  5909. RETURN
  5910.  
  5911.  
  5912. chat:
  5913. chatrequest=0
  5914. chattime=TIME('E')
  5915. SAY 'Entering chat mode with sysop.'CR
  5916. MSG pen3'- Press backslash [\] to exit -'def
  5917. SAY 'Press [RETURN] twice to tell' sysop 'you are finished typing.'CR
  5918. SAY CR
  5919. OPTIONS PROMPT ''
  5920. string=''
  5921. DO WHILE(string~='\')
  5922.   PULL string
  5923.   CALL checkdcd()
  5924. END
  5925. maxtime=maxtime+(TIME('E')-chattime)%1
  5926. RETURN
  5927.  
  5928.  
  5929. readopen:
  5930. PARSE ARG fname
  5931. ok=OPEN(f,fname,'R')
  5932. IF ok~=0 THEN RETURN 1
  5933. line=fname 'failed to open for reading!'
  5934. SAY line||CR
  5935. CALL send2log(line)
  5936. RETURN 0
  5937.  
  5938.  
  5939. writeopen:
  5940. PARSE ARG fname
  5941. CALL CLOSE(f)
  5942. ok=OPEN(f,fname,'W')
  5943. IF ok~=0 THEN RETURN 1
  5944. line=fname 'failed to open for writing!'
  5945. SAY line||CR
  5946. CALL send2log(line)
  5947. RETURN 0
  5948.  
  5949.  
  5950. set_grand:
  5951. SAY 'Setting up public message conferences...'CR
  5952. grand=0
  5953. DO i=1 TO 99
  5954.   IF msg.i='' THEN ITERATE i
  5955.   msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
  5956.   msg.i.1=STATEF(msgpath||i)
  5957.   grand=grand+msg.i.0
  5958. END
  5959. RETURN
  5960.  
  5961.  
  5962. checkstats:          /* clip is set and cleared by stats programs */
  5963. IF TIME('H')>3 & GETCLIP('BBS_STAT')='' THEN
  5964.   DO
  5965.     IF EXISTS(bbspath'Information/STATS.ULDL') THEN
  5966.       DO
  5967.         lfinfo=STATEF(bbspath'Information/STATS.ULDL')
  5968.         IF WORD(lfinfo,5)<DATE('I') THEN
  5969.           DO
  5970.             ADDRESS AREXX bbsULDL.rexx
  5971.             CALL DELAY(100)
  5972.           END
  5973.       END
  5974.     IF TIME('H')>4 & GETCLIP('BBS_STAT')='' & EXISTS(bbspath'Information/STATS.USER') THEN
  5975.       DO
  5976.         ufinfo=STATEF(bbspath'Information/STATS.USER')
  5977.         IF WORD(ufinfo,5)<DATE('I') THEN
  5978.           DO
  5979.             ADDRESS AREXX bbsUSER.rexx
  5980.             CALL DELAY(100)
  5981.           END
  5982.       END
  5983.     IF grand>SYSTEM_MSG_LIMIT & TIME('H')>5 & TIME('H')<9 & GETCLIP('BBS_STAT')='' THEN
  5984.       DO
  5985.         SAY 'Doing Message Conference Maintenence...'CR
  5986.         Send 'ATH1\r'
  5987.         CALL bbsMAINT.baud(SYSTEM_MSG_LIMIT sysop)
  5988.         CALL set_grand()
  5989.         Send 'ATZ\r'
  5990.       END
  5991.   END
  5992. RETURN
  5993.  
  5994.  
  5995. zerovars:
  5996. lastread.=0
  5997. totwrit.=0
  5998. data.=''
  5999. libs.=''
  6000. smsg.=''
  6001. msgs.=''
  6002. sdirs.=''
  6003. pasted.=''
  6004. pasted.0=0
  6005. clear_marked=0
  6006. sortalphaflag=0
  6007. savefileflag=0
  6008. sortuserflag=0
  6009. linesperpage=19
  6010. chatrequest=0
  6011. lastbrowse=0
  6012. buildalpha=0
  6013. terseflag=0
  6014. warnings=0
  6015. winnings=0
  6016. menuflag=0
  6017. nonstop=0
  6018. dirnum=1
  6019. msgdir=1
  6020. level=0
  6021. newfilesflag=0
  6022. newfilesdate=''
  6023. newpassword=''
  6024. replymsg=''
  6025. waitchar=''
  6026. string=''
  6027. name=''
  6028. city='?'
  6029. opt=''
  6030. RETURN
  6031.  
  6032.  
  6033. HALT:
  6034. SYNTAX:
  6035. FAILURE:
  6036. lin.1=pen7||ERRORTEXT(RC)||def
  6037. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  6038. lin.3=SIGL pen7||SOURCELINE(SIGL)||def
  6039. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  6040. DO er=1 TO 4
  6041.   IF level>sysoplevel THEN SAY lin.er||CR
  6042.   CALL send2log(lin.er)
  6043. END
  6044. CALL CLOSE(f)
  6045. IF newpassword='' THEN SIGNAL DONE  /* no user logged on, quit quietly */
  6046. SAY CR
  6047. CALL checkdcd()
  6048. IF level>sysoplevel THEN
  6049.   DO
  6050.     junk=getinput(1 1 'ReStart: (Ny) > ')
  6051.     IF junk~='Y' THEN SIGNAL LOGOUT
  6052.   END
  6053. waitchar=''
  6054. IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
  6055. SIGNAL RESTART
  6056.  
  6057.  
  6058. BREAK_E:
  6059. CALL CLOSE(f)
  6060. SAY pen3'*** CTRL-E BREAK ***'def||CR
  6061. waitchar=''
  6062. string=''
  6063. nonstop=0
  6064. rnonstop=0
  6065. brostop=0
  6066. i=999999
  6067. wi=999999
  6068. ni=0
  6069. QUEUE CR
  6070. RETURN 0
  6071.  
  6072.  
  6073. BREAK_C:
  6074. SIGNAL OFF BREAK_C
  6075. SIGNAL OFF BREAK_E
  6076. CALL CLOSE(f)
  6077. IF newpassword='' THEN
  6078.   DO
  6079.     CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
  6080.     SIGNAL DONE  /* no user logged on, quit quietly */
  6081.   END
  6082. CALL checkdcd()
  6083. SAY CR
  6084. IF warnings<1 THEN  /* just 1 warning */
  6085.   DO
  6086.     warnings=warnings+1
  6087.     SAY 'If you didn''t press CTRL-C then...   HEY!    Wake up!'CR
  6088.     SAY '                                     Auto-disconnect in' TRUNC(maxidle/60+.5) 'minutes!'CR
  6089.     SAY 'If you DID press CTRL-C, please use CTRL-E next time instead.'CR
  6090.     Remote OFF
  6091.     Send '^G\w^G\w^G^G^G^G'
  6092.     Remote ON
  6093.     waitchar=''
  6094.     string=''
  6095.     nonstop=0
  6096.     SIGNAL RESTART
  6097.   END
  6098. CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
  6099. SAY 'No Activity For' TRUNC(maxidle/30+.5) 'minutes! -- Disconnecting.'CR
  6100. Send '\d'
  6101. CALL sound_badlogoff()
  6102. SIGNAL OUT
  6103.  
  6104. LOGOUT:
  6105. junk=getinput(1 1 pen3'Leave Feedback for SysOp? (Ny) > 'def)
  6106. IF junk='Y' THEN
  6107.   DO
  6108.     opt='C'  /* to trigger Feedback as Subject */
  6109.     CALL editor('MAIL' sysop)
  6110.   END
  6111.  
  6112. LOGOUT2:
  6113. SIGNAL OFF BREAK_E
  6114. CALL SETCLIP('BBS_level')
  6115. CALL callsleft()
  6116. secs=TIME('E')
  6117. mins=secs%60
  6118. secs=TRUNC(secs//60)
  6119. IF secs<10 THEN secs='0'secs
  6120. SAY
  6121. SAY 'Public  files   online: 'RIGHT(comma(files.0),9)||CR
  6122. SAY 'Public messages online: 'RIGHT(comma(grand),9)||CR
  6123. SAY CR
  6124. SAY 'Time used this call:' mins':'secs||CR
  6125. SAY 'Goodbye' name', thank you for calling' bbsname'.'CR
  6126. linesperpage=99
  6127. arg=bbspath'BBS_TEXT/GOODBYE'
  6128. IF EXISTS(arg) THEN
  6129.   DO
  6130.     CALL DELAY(14)
  6131.     CALL readlines(arg 1)
  6132.     CALL seelines(0)
  6133.   END
  6134. SAY CR
  6135. IF bbsprefs.2 & ~terseflag THEN CALL doGrin()
  6136. CALL setdir(libpath||dirs.1)
  6137.  
  6138. OUT:
  6139. SIGNAL OFF BREAK_E
  6140. Remote OFF
  6141. data.18=winnings
  6142. line=left(name,16,' ') 'logged off at' time('C')
  6143. dcd
  6144. IF RC~=0 THEN Send '\ah'
  6145. IF data.20~='' THEN
  6146.   DO
  6147.     Status 'Y'
  6148.     elapsed=RESULT
  6149.     line=line 'Total:'elapsed
  6150.     PARSE VAR elapsed thour':'tmin':'.
  6151.     ADDRESS AREXX bbsHOURLY.rexx TIME('H') TIME('M')//60 thour tmin bbspath'Numbers/Hourly'
  6152.     PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls .
  6153.     IF ~DATATYPE(tmin,'N')  THEN tmin=0
  6154.     IF ~DATATYPE(thour,'N') THEN thour=0
  6155.     IF ~DATATYPE(dhour,'N') THEN dhour=0
  6156.     IF ~DATATYPE(dmin,'N')  THEN dmin=0
  6157.     IF ~DATATYPE(calls,'N') THEN calls=0
  6158.     IF thour=0 & tmin<3 THEN  /* free call if less than 3 minutes */
  6159.       DO
  6160.         wordloc=WORDINDEX(data.11,3)-1
  6161.         wordval=WORD(data.11,3)+1
  6162.         data.11=DELWORD(data.11,3,1)
  6163.         data.11=INSERT(wordval' ',data.11,wordloc)
  6164.       END
  6165.     ufile=LEFT(DATE('S'),6)
  6166.     mmins=thour*60+tmin+countcheck(bbspath'Usage/'ufile 0)
  6167.     mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes' 0)
  6168.     cals=countcheck(bbspath'Numbers/Calls' 0)+1
  6169.     CALL countcheck(bbspath'Numbers/Minutes' mins)
  6170.     CALL countcheck(bbspath'Numbers/Calls' cals)
  6171.     CALL countcheck(bbspath'Usage/'ufile mmins)
  6172.     thour=thour+dhour
  6173.     tmin=tmin+dmin+1
  6174.     IF tmin>59 THEN
  6175.       DO
  6176.         thour=thour+tmin%60
  6177.         tmin=tmin//60
  6178.       END
  6179.     data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.'
  6180.     CALL SETCLIP('BBS_totalusage',mmins%60 mmins//60)
  6181.     CALL SETCLIP('BBS_userlogoff',TIME('C') DATE())
  6182.     CALL postuser(6)
  6183.     IF newfilesflag=1 THEN
  6184.       DO
  6185.         newfilesdate=DATE('S') TIME()
  6186.         lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
  6187.       END
  6188.     IF clear_marked=1 THEN data.24=''
  6189.     CALL saveData(1)
  6190.     data.5=''
  6191.     lastline=RIGHT(TIME('C'),7) LEFT(DATE(),6)
  6192.     lastline=lastline'  'RIGHT(city,40)
  6193.     lastline=OVERLAY(name,lastline,16,LENGTH(name)+1) RIGHT(bps,5)
  6194.     lastline=lastline' Time:'elapsed
  6195.     newpassword=''
  6196.     CALL send2last(lastline)
  6197.     SAY lastline||CR
  6198.   END
  6199.  
  6200. OUT2:
  6201. CALL send2log(line)
  6202.  
  6203. DONE:
  6204. CALL send2log('')
  6205.  
  6206. DONE2:
  6207. CALL SETCLIP('BBS_minutes')
  6208. CALL SETCLIP('BBS_demon')
  6209. CALL SETCLIP('BBS_level')
  6210. Capture
  6211. IF RC~=0 THEN Capture OFF
  6212. Send '\c\ah'
  6213. Beep (bm*20)
  6214. CALL DELAY(14)
  6215. Remote OFF
  6216. CALL DELAY(14)
  6217. Beep (bm*30)
  6218. baud maxbps
  6219. IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 THEN
  6220.   CALL DELAY(100)
  6221. ELSE
  6222.   DO
  6223.     Send 'ATH1\r'
  6224.     CALL DELAY(128)
  6225.     Send 'ATH1\r'
  6226.   END
  6227. IF buildalpha~=0 THEN
  6228.   DO
  6229.     CALL BuildALPHA.rexx()
  6230.     sortalphaflag=0
  6231.     savefileflag=0
  6232.     buildalpha=0
  6233.   END
  6234. IF sortuserflag=1 THEN
  6235.   DO
  6236.     CALL sortuserlist()
  6237.     IF SHOW('P','BBBBS_LOCAL') THEN
  6238.       DO
  6239.         CALL SETCLIP('BBS_localusers')
  6240.         CALL SETCLIP('BBS_mainusers',1)
  6241.       END
  6242.   END
  6243. IF sortalphaflag>0 | savefileflag>0 THEN
  6244.   DO
  6245.     IF savefileflag>0 THEN CALL savefilelist2()
  6246.     ELSE CALL savealphalist()
  6247.     IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
  6248.   END
  6249. IF emailonline<0 THEN CALL countmail()
  6250. bad_atz=ATZreset()   /* reset modem */
  6251. IF bbsprefs.15=0 THEN  /* quit or restart? */
  6252.   DO
  6253.     CALL checkstats()
  6254.     EXIT
  6255.   END
  6256. IF STORAGE()<bbsprefs.15 THEN
  6257.   DO
  6258.     SAY CR
  6259.     SAY '*** Unsafe memory level!'CR
  6260.     line='*** Less than' bbsprefs.15 'bytes available, BBBBS has been unloaded.'
  6261.     SAY line||CR
  6262.     SAY CR
  6263.     CALL send2log(line)
  6264.     EXIT
  6265.   END
  6266. CALL CLOSE(f)
  6267. CALL CLOSE('log')
  6268. CALL zerovars()
  6269. DO FOREVER
  6270.   IF GETCLIP('BBS_QUIT')='QUIT' THEN
  6271.     DO
  6272.       CALL SETCLIP('BBS_QUIT')
  6273.       CALL SETCLIP('BBS_maint')
  6274.       CALL SETCLIP('BBS_localfiles')
  6275.       CALL SETCLIP('BBS_localusers')
  6276.       Send '\c'
  6277.       EXIT
  6278.     END
  6279.   xstring=GETCLIP('BBS_interpret')
  6280.   IF xstring~='' THEN
  6281.     DO
  6282.       INTERPRET xstring
  6283.       CALL SETCLIP('BBS_interpret')
  6284.       SIGNAL DONE2
  6285.     END
  6286.   IF bad_atz=1 THEN bad_atz=ATZreset()
  6287.   TimeOut 45
  6288.   IF GETCLIP('BBS_localfiles')>1 & GETCLIP('BBS_maint')='' THEN
  6289.     DO
  6290.       CALL DELAY(150)
  6291.       Send 'ATH1\r'
  6292.       CALL SETCLIP('BBS_localfiles')
  6293.       CALL loadfiles()
  6294.       CALL loadalpha()
  6295.       SIGNAL DONE2
  6296.     END
  6297.   IF GETCLIP('BBS_localusers')~='' THEN
  6298.     DO
  6299.       CALL DELAY(150)
  6300.       Send 'ATH1\r'
  6301.       CALL SETCLIP('BBS_localusers')
  6302.       CALL loaduserlist()
  6303.       SIGNAL DONE2
  6304.     END
  6305.   dcd
  6306.   IF RC~=0 THEN Send '\ah'
  6307.   wres=''
  6308.   Wait 'RING'
  6309.   wres=RESULT
  6310.   IF wres='RING' THEN
  6311.     DO
  6312.       Send 'ATA\r'
  6313.       Timeout 45
  6314.       wres=''
  6315.       Wait 'CONNECT,NO CARRIER,RING' /* wait 45 seconds for connect */
  6316.       wres=RESULT
  6317.       IF wres~='CONNECT' THEN SIGNAL DONE2
  6318.       CALL DELAY(114)
  6319.       SAY ' 'CR
  6320.       CALL DELAY(28)
  6321.       SAY ' 'CR
  6322.       dcd
  6323.       IF RC=0 THEN
  6324.         DO
  6325.           CALL DELAY(128)
  6326.           dcd
  6327.           IF RC=0 THEN
  6328.             DO
  6329.               CALL DELAY(128)
  6330.               dcd
  6331.               IF RC=0 THEN SIGNAL DONE2
  6332.             END
  6333.         END
  6334.       IF GETCLIP('BBS_maint')='' THEN
  6335.         DO
  6336.           CALL SETCLIP('BBS_interpret')
  6337.           CALL DELAY(114)
  6338.           SIGNAL LOGON
  6339.         END
  6340.       Remote ON
  6341.       SAY bbsname 'is busy with periodic maintenance.'CR
  6342.       SAY 'Please try again in a few minutes.'CR
  6343.       Send '\ah'
  6344.       SIGNAL DONE2
  6345.     END
  6346.   ELSE CALL checkstats()
  6347. END
  6348. EXIT
  6349.  
  6350.  
  6351.  
  6352. ATZreset:
  6353. TimeOut 10
  6354. Send '\d\wATZ\r'
  6355. Wait 'OK,RING'
  6356. IF RESULT='OK' THEN RETURN 0
  6357. Send '\d\wATZ\r'
  6358. Wait 'OK,RING'
  6359. IF RESULT~='OK' THEN
  6360.   DO
  6361.     Send '\w\w+++\w\w\w\wATH\r'
  6362.     CALL yellsnd()
  6363.     line='*** ATZ failed to reset!' TIME('C') DATE()
  6364.     SAY line'  Check your modem!!'CR
  6365.     CALL send2log(line)
  6366.     RETURN 1
  6367.   END
  6368. RETURN 0
  6369.  
  6370.  
  6371. getbaudrate: PROCEDURE
  6372. TRACE OFF
  6373. BaudRate
  6374. brate=RC
  6375. TRACE
  6376. RETURN brate
  6377.  
  6378.  
  6379. /* BBBBS.baud */
  6380.